From: Justin Hunter <justin.d.hunter@gmail.com>
Date: Wed, 21 Oct 2009 21:05:21 +0000 (-0700)
Subject: add tests for methods that take a coderef
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=993c43a7cfc5db217f45f43418d8cc86ff7d7711;p=gitmo%2FMoose.git

add tests for methods that take a coderef
add tests for methods dying when invalid args are given
add ->throw_error for invalid args
---

diff --git a/lib/Moose/Meta/Attribute/Native/MethodProvider/Array.pm b/lib/Moose/Meta/Attribute/Native/MethodProvider/Array.pm
index 8ce0e24..d0802a7 100644
--- a/lib/Moose/Meta/Attribute/Native/MethodProvider/Array.pm
+++ b/lib/Moose/Meta/Attribute/Native/MethodProvider/Array.pm
@@ -106,6 +106,7 @@ sub join : method {
     my ( $attr, $reader, $writer ) = @_;
     return sub {
         my ( $instance, $separator ) = @_;
+        $attr->associated_class->throw_error('A separator is required') unless $separator;
         join $separator, @{ $reader->($instance) };
     };
 }
@@ -182,6 +183,7 @@ sub shift : method {
 sub get : method {
     my ( $attr, $reader, $writer ) = @_;
     return sub {
+        $attr->associated_class->throw_error('One argument is expected') if @_ == 1;
         $reader->( $_[0] )->[ $_[1] ];
     };
 }
@@ -265,6 +267,7 @@ sub clear : method {
 sub delete : method {
     my ( $attr, $reader, $writer ) = @_;
     return sub {
+        $attr->associated_class->throw_error('One argument expected') if @_ == 1;
         CORE::splice @{ $reader->( $_[0] ) }, $_[1], 1;
       }
 }
@@ -309,13 +312,21 @@ sub splice : method {
               . ( defined($_) ? $_ : 'undef' )
               . " did not pass container type constraint '$container_type_constraint'"
               for @elems;
-            CORE::splice @{ $reader->($self) }, $i, $j, @elems;
+            defined $i
+                ? defined $j
+                    ? CORE::splice @{ $reader->($self) }, $i, $j, @elems
+                    : CORE::splice @{ $reader->($self) }, $i
+                : CORE::splice @{ $reader->($self) };
         };
     }
     else {
         return sub {
             my ( $self, $i, $j, @elems ) = @_;
-            CORE::splice @{ $reader->($self) }, $i, $j, @elems;
+            defined $i
+                ? defined $j
+                    ? CORE::splice @{ $reader->($self) }, $i, $j, @elems
+                    : CORE::splice @{ $reader->($self) }, $i
+                : CORE::splice @{ $reader->($self) };
         };
     }
 }
diff --git a/t/070_native_traits/202_trait_array.t b/t/070_native_traits/202_trait_array.t
index 25afb92..fd5f23b 100644
--- a/t/070_native_traits/202_trait_array.t
+++ b/t/070_native_traits/202_trait_array.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 68;
+use Test::More tests => 108;
 use Test::Exception;
 use Test::Moose 'does_ok';
 
@@ -23,13 +23,16 @@ my $sort;
             'add_options'           => 'push',
             'remove_last_option'    => 'pop',
             'remove_first_option'   => 'shift',
+            'remove_option_at'      => 'delete',
             'insert_options'        => 'unshift',
+            'insert_option_at'      => 'insert',
             'get_option_at'         => 'get',
             'set_option_at'         => 'set',
             'num_options'           => 'count',
             'has_no_options'        => 'is_empty',
             'clear_options'         => 'clear',
             'splice_options'        => 'splice',
+            'join_options'          => 'join',
             'sort_options_in_place' => 'sort_in_place',
             'option_accessor'       => 'accessor',
             'add_options_with_speed' =>
@@ -38,6 +41,13 @@ my $sort;
                 [ 'unshift' => 'first', 'second' ],
             'descending_options' =>
                 [ 'sort_in_place' => ($sort = sub { $_[1] <=> $_[0] }) ],
+            'first_option'          => 'first',
+            'grep_options'          => 'grep',
+            'map_options'           => 'map',
+            'reduce_options'        => 'reduce',
+            'sort_options'          => 'sort',
+            'unique_options'        => 'uniq',
+            'n_options_atatime'     => 'natatime',
         }
     );
 }
@@ -49,12 +59,15 @@ can_ok( $stuff, $_ ) for qw[
     add_options
     remove_last_option
     remove_first_option
+    remove_option_at
     insert_options
+    insert_option_at
     get_option_at
     set_option_at
     num_options
     clear_options
     has_no_options
+    join_options
     sort_options_in_place
     option_accessor
 ];
@@ -64,8 +77,17 @@ is_deeply( $stuff->options, [ 10, 12 ], '... got options' );
 ok( !$stuff->has_no_options, '... we have options' );
 is( $stuff->num_options, 2, '... got 2 options' );
 
+is( $stuff->join_options(':'), '10:12', '... join returned the correct string' );
+
+is( $stuff->remove_option_at(0), 10, '... removed the correct option' );
+lives_ok {
+    $stuff->insert_option_at(0, 10);
+}
+'... inserted 10';
+is_deeply( $stuff->options, [ 10, 12 ], '... got options' );
+
 is( $stuff->remove_last_option,  12, '... removed the last option' );
-is( $stuff->remove_first_option, 10, '... removed the last option' );
+is( $stuff->remove_first_option, 10, '... removed the first option' );
 
 is_deeply( $stuff->options, [], '... no options anymore' );
 
@@ -73,6 +95,11 @@ ok( $stuff->has_no_options, '... no options' );
 is( $stuff->num_options, 0, '... got no options' );
 
 lives_ok {
+    $stuff->add_options;
+}
+'... set the option ok';
+
+lives_ok {
     $stuff->add_options( 1, 2, 3 );
 }
 '... set the option okay';
@@ -113,6 +140,11 @@ lives_ok {
 }
 '... set the option okay';
 
+lives_ok {
+    $stuff->insert_options;
+}
+'... set the option okay';
+
 is( $stuff->num_options, 6, '... got 6 options' );
 is_deeply( $stuff->options, [ 10, 20, 1, 100, 3, 10 ],
     '... got diff options now' );
@@ -186,18 +218,76 @@ is_deeply(
     'splice added expected option'
 );
 
+lives_ok {
+    $stuff->splice_options( 1, 0 );
+}
+'... splice_options works';
+
+lives_ok {
+    $stuff->splice_options;
+}
+'... splice_options works';
+
+is_deeply(
+    $stuff->options, [ ],
+    'splice worked as expected'
+);
+
 is( $stuff->option_accessor( 1 => 'foo++' ), 'foo++' );
 is( $stuff->option_accessor(1), 'foo++' );
 
+lives_and {
+    my $stuff = Stuff->new( options => [ qw/foo bar baz quux/ ] );
+    is( $stuff->first_option( sub { /^b/ } ), 'bar' );
+}
+'... first worked as expected';
+
+lives_and {
+    my $stuff = Stuff->new( options => [ qw/foo bar baz quux/ ] );
+    is_deeply( [ $stuff->grep_options( sub { /^b/ } ) ], [ 'bar', 'baz' ] );
+}
+'... grep worked as expected';
+
+lives_and {
+    my $stuff = Stuff->new( options => [ qw/foo bar baz quux/ ] );
+    is_deeply( [ $stuff->map_options( sub { $_ . '-Moose' } ) ], [ 'foo-Moose', 'bar-Moose', 'baz-Moose', 'quux-Moose' ] );
+}
+'... map worked as expected';
+
+lives_and {
+    my $stuff = Stuff->new( options => [ qw/foo bar baz quux/ ] );
+    is( $stuff->reduce_options( sub { $_[0] . $_[1] } ), 'foobarbazquux' );
+}
+'... reduce worked as expected';
+
+lives_and {
+    my $stuff = Stuff->new( options => [ qw/foo bar baz quux/ ] );
+    is_deeply( [ $stuff->sort_options( sub { $_[0] cmp $_[1] } ) ], [ 'bar', 'baz', 'foo', 'quux' ] );
+}
+'... sort worked as expected';
+
+lives_and {
+    my $stuff = Stuff->new( options => [ qw/foo bar bar baz quux baz foo/ ] );
+    is_deeply( [ $stuff->unique_options ], [ 'foo', 'bar', 'baz', 'quux' ] );
+}
+'... uniq worked as expected';
+
+lives_and {
+    my $stuff = Stuff->new( options => [ 'a' .. 'z' ]);
+    my $it = $stuff->n_options_atatime(2);
+    isa_ok( $it, 'List::MoreUtils_na' );
+    while (my @vals = $it->()) {
+        is( @vals, 2 );
+    }
+}
+'... natatime works as expected';
+
 ## check some errors
 
-#dies_ok {
-#    $stuff->insert_options(undef);
-#} '... could not add an undef where a string is expected';
-#
-#dies_ok {
-#    $stuff->set_option(5, {});
-#} '... could not add a hash ref where a string is expected';
+dies_ok {
+    $stuff->set_option(5, {});
+}
+'... could not add a hash ref where a string is expected';
 
 dies_ok {
     Stuff->new( options => [ undef, 10, undef, 20 ] );
@@ -205,41 +295,70 @@ dies_ok {
 '... bad constructor params';
 
 dies_ok {
-    my $stuff = Stuff->new();
+    $stuff->first(undef);
+}
+'... rejects first of an invalid type';
+
+dies_ok {
     $stuff->add_options(undef);
 }
 '... rejects push of an invalid type';
 
 dies_ok {
-    my $stuff = Stuff->new();
     $stuff->insert_options(undef);
 }
 '... rejects unshift of an invalid type';
 
 dies_ok {
-    my $stuff = Stuff->new();
     $stuff->set_option_at( 0, undef );
 }
 '... rejects set of an invalid type';
 
 dies_ok {
-    my $stuff = Stuff->new();
+    $stuff->insert_option_at( 0, undef );
+}
+'... rejects insert of an invalid type';
+
+dies_ok {
     $stuff->sort_in_place_options(undef);
 }
 '... sort rejects arg of invalid type';
 
 dies_ok {
-    my $stuff = Stuff->new();
     $stuff->option_accessor();
 }
 '... accessor rejects 0 args';
 
 dies_ok {
-    my $stuff = Stuff->new();
     $stuff->option_accessor( 1, 2, 3 );
 }
 '... accessor rejects 3 args';
 
+dies_ok {
+    $stuff->join;
+}
+'... join rejects invalid separator';
+
+dies_ok {
+    $stuff->remove_option_at;
+}
+'... delete rejects invalid index';
+
+dies_ok {
+    $stuff->get_option_at;
+}
+'... get rejects invalid index';
+
+dies_ok {
+    $stuff->set_option_at;
+}
+'... set rejects invalid index/value';
+
+dies_ok {
+    $stuff->insert_option_at;
+}
+'... insert rejects invalid index/value';
+
 ## test the meta
 
 my $options = $stuff->meta->get_attribute('options');
@@ -251,19 +370,29 @@ is_deeply(
         'add_options'           => 'push',
         'remove_last_option'    => 'pop',
         'remove_first_option'   => 'shift',
+        'remove_option_at'      => 'delete',
         'insert_options'        => 'unshift',
+        'insert_option_at'      => 'insert',
         'get_option_at'         => 'get',
         'set_option_at'         => 'set',
         'num_options'           => 'count',
         'has_no_options'        => 'is_empty',
         'clear_options'         => 'clear',
         'splice_options'        => 'splice',
+        'join_options'          => 'join',
         'sort_options_in_place' => 'sort_in_place',
         'option_accessor'       => 'accessor',
         'add_options_with_speed' => [ 'push' => 'funrolls', 'funbuns' ],
         'prepend_prerequisites_along_with' =>
             [ 'unshift' => 'first', 'second' ],
         'descending_options' => [ 'sort_in_place' => $sort ],
+        'first_option'         => 'first',
+        'grep_options'         => 'grep',
+        'map_options'          => 'map',
+        'reduce_options'       => 'reduce',
+        'sort_options'         => 'sort',
+        'unique_options'       => 'uniq',
+        'n_options_atatime'    => 'natatime',
     },
     '... got the right handles mapping'
 );