From: Hans Dieter Pearcey <hdp@weftsoar.net>
Date: Thu, 25 Jun 2009 20:22:53 +0000 (-0400)
Subject: update trait tests with basic test diffs
X-Git-Tag: 0.21~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-AttributeHelpers.git;a=commitdiff_plain;h=301da83f19b55bb13e0d4379ab3e9e6ad1504595

update trait tests with basic test diffs
---

diff --git a/t/201_trait_counter.t b/t/201_trait_counter.t
index 41875fd..cd281c0 100644
--- a/t/201_trait_counter.t
+++ b/t/201_trait_counter.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 14;
+use Test::More tests => 18;
 use Test::Moose 'does_ok';
 
 BEGIN {
@@ -23,6 +23,7 @@ BEGIN {
             inc   => 'inc_counter',
             dec   => 'dec_counter',
             reset => 'reset_counter',
+            set   => 'set_counter'
         }
     );
 }
@@ -34,6 +35,7 @@ can_ok($page, $_) for qw[
     dec_counter 
     inc_counter
     reset_counter
+    set_counter
 ];
 
 is($page->counter, 0, '... got the default value');
@@ -50,6 +52,15 @@ is($page->counter, 1, '... got the decremented value');
 $page->reset_counter;
 is($page->counter, 0, '... got the original value');
 
+$page->set_counter(5);
+is($page->counter, 5, '... set the value');
+
+$page->inc_counter(2);
+is($page->counter, 7, '... increment by arg');
+
+$page->dec_counter(5);
+is($page->counter, 2, '... decrement by arg');
+
 # check the meta ..
 
 my $counter = $page->meta->get_attribute('counter');
@@ -62,6 +73,7 @@ is($counter->type_constraint->name, 'Int', '... got the expected type constraint
 is_deeply($counter->provides, { 
     inc   => 'inc_counter',
     dec   => 'dec_counter',
-    reset => 'reset_counter',        
+    reset => 'reset_counter',
+    set   => 'set_counter'
 }, '... got the right provides methods');
 
diff --git a/t/202_trait_array.t b/t/202_trait_array.t
index 5fe04a6..23976ce 100644
--- a/t/202_trait_array.t
+++ b/t/202_trait_array.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 51;
+use Test::More tests => 69;
 use Test::Exception;
 use Test::Moose 'does_ok';
 
@@ -18,18 +18,31 @@ BEGIN {
     has 'options' => (
         traits    => [qw/MooseX::AttributeHelpers::Trait::Collection::Array/],
         is        => 'ro',
-        isa       => 'ArrayRef[Int]',
+        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',        
+        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',
+            'splice'        => 'splice_options',
+            'sort_in_place' => 'sort_options_in_place',
+            'accessor'      => 'option_accessor',
+            },
+        curries   => {
+            'push'    => {
+                add_options_with_speed => ['funrolls', 'funbuns']
+            },
+            'unshift'  => {
+                prepend_prerequisites_along_with => ['first', 'second']
+            },
+            'sort_in_place' => { descending_options => [ sub { $_[1] <=> $_[0] } ],
+            },
         }
     );
 }
@@ -47,6 +60,8 @@ can_ok($stuff, $_) for qw[
     num_options
     clear_options
     has_options
+    sort_options_in_place
+    option_accessor
 ];
 
 is_deeply($stuff->options, [10, 12], '... got options');
@@ -113,23 +128,99 @@ is($stuff->get_option_at(0), 20, '... get option at index 0');
 $stuff->clear_options;
 is_deeply( $stuff->options, [], "... clear options" );
 
+$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)" );
+
+$stuff->sort_options_in_place( sub { $_[1] <=> $_[0] } );
+is_deeply( $stuff->options, [5, 3, 2, 1], "... sort options in place (descending order)" );
+
+$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 {
+    $stuff->add_options('tree');
+} '... set the options okay';
+
+lives_ok {
+    $stuff->add_options_with_speed('compatible', 'safe');
+} '... add options with speed okay';
+
+is_deeply($stuff->options, [qw/tree funrolls funbuns compatible safe/],
+          'check options after add_options_with_speed');
+
+lives_ok {
+    $stuff->prepend_prerequisites_along_with();
+} '... add prerequisite options okay';
+
+$stuff->clear_options;
+$stuff->add_options( 1, 2 );
+
+lives_ok {
+    $stuff->splice_options( 1, 0, 'foo' );
+} '... splice_options works';
+
+is_deeply(
+    $stuff->options, [ 1, 'foo', 2 ],
+    'splice added expected option'
+);
+
+is($stuff->option_accessor(1 => 'foo++'), 'foo++');
+is($stuff->option_accessor(1), 'foo++');
+
 ## 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->add_options([]);
-} '... could not add an array ref where an int is expected';
+    Stuff->new(options => [ undef, 10, undef, 20 ]);
+} '... bad constructor params';
 
 dies_ok {
+    my $stuff = Stuff->new();
+    $stuff->add_options(undef);
+} '... rejects push of an invalid type';
+
+dies_ok {
+    my $stuff = Stuff->new();
     $stuff->insert_options(undef);
-} '... could not add an undef where an int is expected';
+} '... rejects unshift of an invalid type';
 
 dies_ok {
-    $stuff->set_option(5, {});
-} '... could not add a hash ref where an int is expected';
+    my $stuff = Stuff->new();
+    $stuff->set_option_at( 0, undef );
+} '... rejects set of an invalid type';
 
 dies_ok {
-    Stuff->new(options => [ 'Foo', 10, 'Bar', 20 ]);
-} '... bad constructor params';
+    my $stuff = Stuff->new();
+    $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';
 
 ## test the meta
 
@@ -146,6 +237,9 @@ is_deeply($options->provides, {
     'count'   => 'num_options',
     'empty'   => 'has_options',    
     'clear'   => 'clear_options',    
-}, '... got the right provies mapping');
+    'splice'  => 'splice_options',
+    'sort_in_place' => 'sort_options_in_place',
+    'accessor' => 'option_accessor',
+}, '... got the right provides mapping');
 
-is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
+is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
diff --git a/t/203_trait_hash.t b/t/203_trait_hash.t
index 509b2a6..8e876b1 100644
--- a/t/203_trait_hash.t
+++ b/t/203_trait_hash.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 35;
+use Test::More tests => 47;
 use Test::Exception;
 use Test::Moose 'does_ok';
 
@@ -22,12 +22,22 @@ BEGIN {
         isa       => 'HashRef[Str]',
         default   => sub { {} },
         provides  => {
-            'set'    => 'set_option',
-            'get'    => 'get_option',            
-            'empty'  => 'has_options',
-            'count'  => 'num_options',
-            'clear'  => 'clear_options',
-            'delete' => 'delete_option',
+            'set'      => 'set_option',
+            'get'      => 'get_option',
+            'empty'    => 'has_options',
+            'count'    => 'num_options',
+            'clear'    => 'clear_options',
+            'delete'   => 'delete_option',
+            'exists'   => 'has_option',
+            'defined'  => 'is_defined',
+            'accessor' => 'option_accessor',
+            'kv'       => 'key_value',
+            'elements' => 'options_elements',
+        },
+        curries   => {
+            'accessor' => {
+                quantity => ['quantity'],
+            },
         }
     );
 }
@@ -42,19 +52,27 @@ can_ok($stuff, $_) for qw[
     num_options
     delete_option
     clear_options
+    is_defined
+    has_option
+    quantity
+    option_accessor
 ];
 
 ok(!$stuff->has_options, '... we have no options');
 is($stuff->num_options, 0, '... we have no options');
 
 is_deeply($stuff->options, {}, '... no options yet');
+ok(!$stuff->has_option('foo'), '... we have no foo option');
 
 lives_ok {
     $stuff->set_option(foo => 'bar');
 } '... set the option okay';
 
+ok($stuff->is_defined('foo'), '... foo is defined');
+
 ok($stuff->has_options, '... we have options');
 is($stuff->num_options, 1, '... we have 1 option(s)');
+ok($stuff->has_option('foo'), '... we have a foo option');
 is_deeply($stuff->options, { foo => 'bar' }, '... got options now');
 
 lives_ok {
@@ -95,6 +113,14 @@ $stuff->clear_options;
 is_deeply($stuff->options, { }, "... cleared options" );
 
 lives_ok {
+    $stuff->quantity(4);
+} '... options added okay with defaults';
+
+is($stuff->quantity, 4, 'reader part of curried accessor works');
+
+is_deeply($stuff->options, {quantity => 4}, '... returns what we expect');
+
+lives_ok {
     Stuff->new(options => { foo => 'BAR' });
 } '... good constructor params';
 
@@ -114,12 +140,36 @@ my $options = $stuff->meta->get_attribute('options');
 does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::Hash');
 
 is_deeply($options->provides, {
-    'set'    => 'set_option',
-    'get'    => 'get_option',            
-    'empty'  => 'has_options',
-    'count'  => 'num_options',
-    'clear'  => 'clear_options',
-    'delete' => 'delete_option',
-}, '... got the right provies mapping');
+    'set'      => 'set_option',
+    'get'      => 'get_option',
+    'empty'    => 'has_options',
+    'count'    => 'num_options',
+    'clear'    => 'clear_options',
+    'delete'   => 'delete_option',
+    'defined'  => 'is_defined',
+    'exists'   => 'has_option',
+    'accessor' => 'option_accessor',
+    'kv'       => 'key_value',
+    'elements' => 'options_elements',
+}, '... got the right provides mapping');
 
 is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
+
+$stuff->set_option( oink => "blah", xxy => "flop" );
+my @key_value = $stuff->key_value;
+is_deeply(
+    \@key_value,
+    [ [ 'xxy', 'flop' ], [ 'quantity', 4 ], [ 'oink', 'blah' ] ],
+    '... got the right key value pairs'
+);
+
+my %options_elements = $stuff->options_elements;
+is_deeply(
+    \%options_elements,
+    {
+        'oink'     => 'blah',
+        'quantity' => 4,
+        'xxy'      => 'flop'
+    },
+    '... got the right hash elements'
+);
diff --git a/t/204_trait_number.t b/t/204_trait_number.t
index bb1bead..ecb1f2e 100644
--- a/t/204_trait_number.t
+++ b/t/204_trait_number.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 20;
+use Test::More tests => 26;
 use Test::Moose;
 
 BEGIN {
@@ -20,13 +20,19 @@ BEGIN {
         isa       => 'Int',
         default   => sub { 5 },
         provides  => {
-            set => 'set',
-            add => 'add',
-            sub => 'sub',
-            mul => 'mul',
-            div => 'div',
-            mod => 'mod',
-            abs => 'abs',
+            set       => 'set',
+            add       => 'add',
+            sub       => 'sub',
+            mul       => 'mul',
+            div       => 'div',
+            mod       => 'mod',
+            abs       => 'abs',
+        },
+        curries   => {
+            add       => {inc         => [ 1 ]},
+            sub       => {dec         => [ 1 ]},
+            mod       => {odd         => [ 2 ]},
+            div       => {cut_in_half => [ 2 ]}
         }
     );
 }
@@ -35,7 +41,7 @@ my $real = Real->new;
 isa_ok($real, 'Real');
 
 can_ok($real, $_) for qw[
-    set add sub mul div mod abs
+    set add sub mul div mod abs inc dec odd cut_in_half
 ];
 
 is $real->integer, 5, 'Default to five';
@@ -76,6 +82,16 @@ $real->abs;
 
 is $real->integer, 1, 'abs 1';
 
+$real->set(12);
+
+$real->inc;
+
+is $real->integer, 13, 'inc 12';
+
+$real->dec;
+
+is $real->integer, 12, 'dec 13';
+
 ## test the meta
 
 my $attr = $real->meta->get_attribute('integer');
diff --git a/t/205_trait_list.t b/t/205_trait_list.t
index ec0647c..3af97be 100644
--- a/t/205_trait_list.t
+++ b/t/205_trait_list.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 21;
+use Test::More tests => 35;
 use Test::Exception;
 use Test::Moose 'does_ok';
 
@@ -29,8 +29,33 @@ BEGIN {
             'find'     => 'find_option',
             'elements' => 'options',
             'join'     => 'join_options',
+            'get'      => 'get_option_at',
+            'first'    => 'get_first_option',
+            'last'     => 'get_last_option',
+            'sort'     => 'sorted_options',
+        },
+        curries   => {
+            'grep'     => {less_than_five => [ sub { $_ < 5 } ]},
+            'map'      => {up_by_one      => [ sub { $_ + 1 } ]},
+            'join'     => {dashify        => [ '-' ]},
+            'sort'     => {descending     => [ sub { $_[1] <=> $_[0] } ]},
         }
     );
+
+    has animals => (
+        is       => 'rw',
+        isa      => 'ArrayRef[Str]',
+        metaclass => 'Collection::List',
+        curries => {
+            grep =>  {
+                double_length_of => sub {
+                    my ($self, $body, $arg) = @_;
+
+                    $body->($self, sub { length($_) == length($arg) * 2 });
+                }
+            }
+        }
+    )
 }
 
 my $stuff = Stuff->new(options => [ 1 .. 10 ]);
@@ -45,12 +70,17 @@ can_ok($stuff, $_) for qw[
     find_option
     options
     join_options
+    get_option_at
+    sorted_options
 ];
 
 is_deeply($stuff->_options, [1 .. 10], '... got options');
 
 ok($stuff->has_options, '... we have options');
 is($stuff->num_options, 10, '... got 2 options');
+cmp_ok($stuff->get_option_at(0), '==', 1, '... get option 0');
+cmp_ok($stuff->get_first_option, '==', 1, '... get first');
+cmp_ok($stuff->get_last_option, '==', 10, '... get last');
 
 is_deeply(
 [ $stuff->filter_options(sub { $_[0] % 2 == 0 }) ],
@@ -70,6 +100,32 @@ is_deeply([ $stuff->options ], [1 .. 10], '... got the list of options');
 
 is($stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10', '... joined the list of options by :');
 
+is_deeply([ $stuff->sorted_options ], [sort (1..10)],
+          '... got sorted options (default sort order)');
+is_deeply([ $stuff->sorted_options( sub { $_[1] <=> $_[0] } ) ], [sort { $b <=> $a } (1..10)],
+          '... got sorted options (descending sort order) ');
+
+throws_ok { $stuff->sorted_options('foo') } qr/Argument must be a code reference/,
+    'error when sort receives a non-coderef argument';
+
+# test the currying
+is_deeply([ $stuff->less_than_five() ], [1 .. 4]);
+
+is_deeply([ $stuff->up_by_one() ], [2 .. 11]);
+
+is($stuff->dashify, '1-2-3-4-5-6-7-8-9-10');
+
+$stuff->animals([ qw/cat duck horse cattle gorilla elephant flamingo kangaroo/ ]);
+
+# 4 * 2 = 8
+is_deeply(
+        [ sort $stuff->double_length_of('fish') ],
+        [ sort qw/elephant flamingo kangaroo/ ],
+        'returns all elements with double length of string "fish"'
+);
+
+is_deeply([$stuff->descending], [reverse 1 .. 10]);
+
 ## test the meta
 
 my $options = $stuff->meta->get_attribute('_options');
@@ -83,6 +139,15 @@ is_deeply($options->provides, {
     'empty'    => 'has_options',
     'elements' => 'options',
     'join'     => 'join_options',
-}, '... got the right provies mapping');
+    'get'      => 'get_option_at',
+    'first'    => 'get_first_option',
+    'last'     => 'get_last_option',
+    'sort'     => 'sorted_options',
+}, '... got the right provides mapping');
 
 is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
+
+dies_ok {
+    $stuff->sort_in_place_options( undef );
+} '... sort rejects arg of invalid type';
+
diff --git a/t/207_trait_string.t b/t/207_trait_string.t
index 5096cec..7eb470e 100644
--- a/t/207_trait_string.t
+++ b/t/207_trait_string.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 17;
+use Test::More tests => 27;
 use Test::Moose 'does_ok';
 
 BEGIN {
@@ -28,6 +28,13 @@ BEGIN {
             chop    => 'chop_string',
             chomp   => 'chomp_string',
             clear   => 'clear_string',
+            substr  => 'sub_string',
+        },
+        curries  => {
+            append  => {exclaim         => [ '!' ]},
+            replace => {capitalize_last => [ qr/(.)$/, sub { uc $1 } ]},
+            match   => {invalid_number  => [ qr/\D/ ]},
+            substr  => {shift_chars     => sub { $_[1]->($_[0], 0, $_[2], '') } },
         }
     );
 }
@@ -65,6 +72,27 @@ is_deeply( [ $page->match_string(qr/([ao])/) ], [ "a" ], "match" );
 $page->replace_string(qr/([ao])/, sub { uc($1) });
 is($page->string, 'bArcfo', "substitution");
 
+$page->exclaim;
+is($page->string, 'bArcfo!', 'exclaim!');
+
+is($page->sub_string(2), 'rcfo!', 'substr(offset)');
+is($page->sub_string(2, 2), 'rc', 'substr(offset, length)');
+is($page->sub_string(2, 2, ''), 'rc', 'substr(offset, length, replacement)');
+is($page->string, 'bAfo!', 'replacement got inserted');
+
+is($page->shift_chars(2), 'bA', 'curried substr');
+is($page->string, 'fo!', 'replacement got inserted');
+
+$page->string('Moosex');
+$page->capitalize_last;
+is($page->string, 'MooseX', 'capitalize last');
+
+$page->string('1234');
+ok(!$page->invalid_number, 'string "isn\'t an invalid number');
+
+$page->string('one two three four');
+ok($page->invalid_number, 'string an invalid number');
+
 $page->clear_string;
 is($page->string, '', "clear");
 
@@ -86,5 +114,6 @@ is_deeply($string->provides, {
     chop    => 'chop_string',
     chomp   => 'chomp_string',
     clear   => 'clear_string',
+    substr  => 'sub_string',
 }, '... got the right provides methods');