[Moose-commits] r7343 - in MooseX-AttributeHelpers/trunk: lib/MooseX/AttributeHelpers/MethodProvider t

autarch at code2.0beta.co.uk autarch at code2.0beta.co.uk
Sun Jan 18 21:32:09 GMT 2009


Author: autarch
Date: 2009-01-18 13:32:09 -0800 (Sun, 18 Jan 2009)
New Revision: 7343

Modified:
   MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm
   MooseX-AttributeHelpers/trunk/t/002_basic_array.t
Log:
Make coderef for sort_in_place optional as well.

Modified: MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm
===================================================================
--- MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm	2009-01-18 21:24:32 UTC (rev 7342)
+++ MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm	2009-01-18 21:32:09 UTC (rev 7343)
@@ -137,15 +137,23 @@
 }
 
 sub sort_in_place : method {
-   my ($attr, $reader, $writer) = @_;
-   return sub {
-      my ($instance, $predicate) = @_;
-      die "Argument must be a code reference" 
-         unless ref $predicate eq "CODE";
-      my @sorted = 
-         CORE::sort { $predicate->($a, $b) } @{$reader->($instance)};
-      $writer->($instance, \@sorted); 
-   }
+    my ($attr, $reader, $writer) = @_;
+    return sub {
+        my ($instance, $predicate) = @_;
+
+        die "Argument must be a code reference"
+            if $predicate && ref $predicate ne 'CODE';
+
+        my @sorted;
+        if ($predicate) {
+            @sorted = CORE::sort { $predicate->($a, $b) } @{$reader->($instance)};
+        }
+        else {
+            @sorted = CORE::sort @{$reader->($instance)};
+        }
+
+        $writer->($instance, \@sorted);
+    };
 }
 
 1;
@@ -157,7 +165,7 @@
 =head1 NAME
 
 MooseX::AttributeHelpers::MethodProvider::Array
-  
+
 =head1 DESCRIPTION
 
 This is a role which provides the method generators for 
@@ -199,10 +207,13 @@
 =item B<splice>
 
 =item B<sort_in_place>
-Sorts the array using the comparison subroutine given as argument.
-Instead of returning the sorted list, it modifies the order of the
-items in the ArrayRef attribute.
 
+Sorts the array I<in place>, modifying the value of the attribute.
+
+You can provide an optional subroutine reference to sort with (as you
+can with the core C<sort> function). However, instead of using C<$a>
+and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead.
+
 =back
 
 =head1 BUGS

Modified: MooseX-AttributeHelpers/trunk/t/002_basic_array.t
===================================================================
--- MooseX-AttributeHelpers/trunk/t/002_basic_array.t	2009-01-18 21:24:32 UTC (rev 7342)
+++ MooseX-AttributeHelpers/trunk/t/002_basic_array.t	2009-01-18 21:32:09 UTC (rev 7343)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 60;
+use Test::More tests => 62;
 use Test::Exception;
 
 BEGIN {
@@ -19,18 +19,18 @@
         is        => 'ro',
         isa       => 'ArrayRef[Str]',
         default   => sub { [] },
-        provides  => {
-            'push'    => 'add_options',
-            'pop'     => 'remove_last_option',    
-            'shift'   => 'remove_first_option',
-            'unshift' => 'insert_options',
-            'get'     => 'get_option_at',
-            'set'     => 'set_option_at',
-            'count'   => 'num_options',
-            'empty'   => 'has_options',        
-            'clear'   => 'clear_options',        
-            'sort_in_place' => 'sort_in_place_options',
-        },
+        provides => {
+            'push'          => 'add_options',
+            'pop'           => 'remove_last_option',
+            'shift'         => 'remove_first_option',
+            'unshift'       => 'insert_options',
+            'get'           => 'get_option_at',
+            'set'           => 'set_option_at',
+            'count'         => 'num_options',
+            'empty'         => 'has_options',
+            'clear'         => 'clear_options',
+            'sort_in_place' => 'sort_options_in_place',
+            },
         curries   => {
             'push'    => {
                 add_options_with_speed => ['funrolls', 'funbuns']
@@ -38,7 +38,7 @@
             'unshift'  => {
                 prepend_prerequisites_along_with => ['first', 'second']
             },
-            'sort_in_place' => { ascending_options => [ sub { $_[0] <=> $_[1] } ],
+            'sort_in_place' => { descending_options => [ sub { $_[1] <=> $_[0] } ],
             },
         }
     );
@@ -57,7 +57,7 @@
     num_options
     clear_options
     has_options
-    sort_in_place_options
+    sort_options_in_place
 ];
 
 is_deeply($stuff->options, [10, 12], '... got options');
@@ -124,16 +124,24 @@
 $stuff->clear_options;
 is_deeply( $stuff->options, [], "... clear options" );
 
-$stuff->add_options(1..3);
-$stuff->sort_in_place_options( sub { $_[1] <=> $_[0] } );
-is_deeply( $stuff->options, [3, 2, 1], "... sort options in place" );
+$stuff->add_options(5, 1, 2, 3);
+$stuff->sort_options_in_place;
+is_deeply( $stuff->options, [1, 2, 3, 5], "... sort options in place (default sort order)" );
 
-lives_ok { 
-   $stuff->ascending_options();
-} '... add descending options okay';
+$stuff->sort_options_in_place( sub { $_[1] <=> $_[0] } );
+is_deeply( $stuff->options, [5, 3, 2, 1], "... sort options in place (descending order)" );
 
-is_deeply( $stuff->options, [1, 2, 3], "... sort currying" );
+$stuff->clear_options();
+$stuff->add_options(5, 1, 2, 3);
+lives_ok {
+   $stuff->descending_options();
+} '... curried sort in place lives ok';
 
+is_deeply( $stuff->options, [5, 3, 2, 1], "... sort currying" );
+
+throws_ok { $stuff->sort_options_in_place('foo') } qr/Argument must be a code reference/,
+    'error when sort_in_place receives a non-coderef argument';
+
 $stuff->clear_options;
 
 lives_ok {
@@ -199,7 +207,7 @@
     'count'   => 'num_options',
     'empty'   => 'has_options',    
     'clear'   => 'clear_options',    
-    'sort_in_place' => 'sort_in_place_options',
-}, '... got the right provies mapping');
+    'sort_in_place' => 'sort_options_in_place',
+}, '... got the right provides mapping');
 
 is($options->type_constraint->type_parameter, 'Str', '... got the right container type');




More information about the Moose-commits mailing list