From: Hans Dieter Pearcey Date: Thu, 25 Jun 2009 20:31:30 +0000 (-0400) Subject: import changes from MXAH repo X-Git-Tag: 0.89_02~133 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=59de9de4bad6394ed8e23ab3f6cfafea32ac4c31;p=gitmo%2FMoose.git import changes from MXAH repo --- diff --git a/t/070_attribute_helpers/201_trait_counter.t b/t/070_attribute_helpers/201_trait_counter.t index dafff01..adb23f5 100644 --- a/t/070_attribute_helpers/201_trait_counter.t +++ b/t/070_attribute_helpers/201_trait_counter.t @@ -3,11 +3,11 @@ use strict; use warnings; -use Test::More tests => 14; +use Test::More tests => 18; use Test::Moose 'does_ok'; BEGIN { - use_ok('Moose::AttributeHelpers'); + use_ok('MooseX::AttributeHelpers'); } { @@ -15,7 +15,7 @@ BEGIN { use Moose; has 'counter' => ( - traits => [qw/Counter/], + traits => [qw/MooseX::AttributeHelpers::Trait::Counter/], is => 'ro', isa => 'Int', default => sub { 0 }, @@ -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,10 +52,19 @@ 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'); -does_ok($counter, 'Moose::AttributeHelpers::Trait::Counter'); +does_ok($counter, 'MooseX::AttributeHelpers::Trait::Counter'); is($counter->helper_type, 'Num', '... got the expected helper type'); @@ -63,5 +74,6 @@ is_deeply($counter->provides, { inc => 'inc_counter', dec => 'dec_counter', reset => 'reset_counter', + set => 'set_counter' }, '... got the right provides methods'); diff --git a/t/070_attribute_helpers/202_trait_array.t b/t/070_attribute_helpers/202_trait_array.t index ceae233..dfd506c 100644 --- a/t/070_attribute_helpers/202_trait_array.t +++ b/t/070_attribute_helpers/202_trait_array.t @@ -3,12 +3,12 @@ use strict; use warnings; -use Test::More tests => 51; +use Test::More tests => 69; use Test::Exception; use Test::Moose 'does_ok'; BEGIN { - use_ok('Moose::AttributeHelpers'); + use_ok('MooseX::AttributeHelpers'); } { @@ -16,20 +16,33 @@ BEGIN { use Moose; has 'options' => ( - traits => [qw/Collection::Array/], + 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,28 +128,104 @@ 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 my $options = $stuff->meta->get_attribute('options'); -does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::Array'); +does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::Array'); is_deeply($options->provides, { 'push' => 'add_options', @@ -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/070_attribute_helpers/203_trait_hash.t b/t/070_attribute_helpers/203_trait_hash.t index 5d096ac..b6ab509 100644 --- a/t/070_attribute_helpers/203_trait_hash.t +++ b/t/070_attribute_helpers/203_trait_hash.t @@ -3,31 +3,41 @@ use strict; use warnings; -use Test::More tests => 35; +use Test::More tests => 47; use Test::Exception; use Test::Moose 'does_ok'; BEGIN { - use_ok('Moose::AttributeHelpers'); + use_ok('MooseX::AttributeHelpers'); } { package Stuff; use Moose; - use Moose::AttributeHelpers; + use MooseX::AttributeHelpers; has 'options' => ( - traits => [qw/Collection::Hash/], + traits => [qw/MooseX::AttributeHelpers::Trait::Collection::Hash/], is => 'ro', 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'; @@ -111,15 +137,39 @@ dies_ok { ## test the meta my $options = $stuff->meta->get_attribute('options'); -does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::Hash'); +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/070_attribute_helpers/204_trait_number.t b/t/070_attribute_helpers/204_trait_number.t index 4179c58..21baf38 100644 --- a/t/070_attribute_helpers/204_trait_number.t +++ b/t/070_attribute_helpers/204_trait_number.t @@ -3,11 +3,11 @@ use strict; use warnings; -use Test::More tests => 20; +use Test::More tests => 26; use Test::Moose; BEGIN { - use_ok('Moose::AttributeHelpers'); + use_ok('MooseX::AttributeHelpers'); } { @@ -15,18 +15,24 @@ BEGIN { use Moose; has 'integer' => ( - traits => [qw/Number/], + traits => [qw/MooseX::AttributeHelpers::Trait::Number/], is => 'ro', 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,10 +82,20 @@ $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'); -does_ok($attr, 'Moose::AttributeHelpers::Trait::Number'); +does_ok($attr, 'MooseX::AttributeHelpers::Trait::Number'); is_deeply($attr->provides, { set => 'set', diff --git a/t/070_attribute_helpers/205_trait_list.t b/t/070_attribute_helpers/205_trait_list.t index 21d3fd7..286ad30 100644 --- a/t/070_attribute_helpers/205_trait_list.t +++ b/t/070_attribute_helpers/205_trait_list.t @@ -3,12 +3,12 @@ use strict; use warnings; -use Test::More tests => 21; +use Test::More tests => 35; use Test::Exception; use Test::Moose 'does_ok'; BEGIN { - use_ok('Moose::AttributeHelpers'); + use_ok('MooseX::AttributeHelpers'); } { @@ -16,7 +16,7 @@ BEGIN { use Moose; has '_options' => ( - traits => [qw/Collection::List/], + traits => [qw/MooseX::AttributeHelpers::Trait::Collection::List/], is => 'ro', isa => 'ArrayRef[Int]', init_arg => 'options', @@ -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,10 +100,36 @@ 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'); -does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::List'); +does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::List'); is_deeply($options->provides, { 'map' => 'map_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/070_attribute_helpers/206_trait_bag.t b/t/070_attribute_helpers/206_trait_bag.t index fba4959..e6c69b5 100644 --- a/t/070_attribute_helpers/206_trait_bag.t +++ b/t/070_attribute_helpers/206_trait_bag.t @@ -8,16 +8,16 @@ use Test::Exception; use Test::Moose 'does_ok'; BEGIN { - use_ok('Moose::AttributeHelpers'); + use_ok('MooseX::AttributeHelpers'); } { package Stuff; use Moose; - use Moose::AttributeHelpers; + use MooseX::AttributeHelpers; has 'word_histogram' => ( - traits => [qw/Collection::Bag/], + traits => [qw/MooseX::AttributeHelpers::Trait::Collection::Bag/], is => 'ro', handles => { 'add_word' => 'add', @@ -65,7 +65,7 @@ is($stuff->get_count_for('baz'), 11, '... got words now'); ## test the meta my $words = $stuff->meta->get_attribute('word_histogram'); -does_ok($words, 'Moose::AttributeHelpers::Trait::Collection::Bag'); +does_ok($words, 'MooseX::AttributeHelpers::Trait::Collection::Bag'); is_deeply($words->handles, { 'add_word' => 'add', diff --git a/t/070_attribute_helpers/207_trait_string.t b/t/070_attribute_helpers/207_trait_string.t index 84f28d5..39966f0 100644 --- a/t/070_attribute_helpers/207_trait_string.t +++ b/t/070_attribute_helpers/207_trait_string.t @@ -3,11 +3,11 @@ use strict; use warnings; -use Test::More tests => 17; +use Test::More tests => 27; use Test::Moose 'does_ok'; BEGIN { - use_ok('Moose::AttributeHelpers'); + use_ok('MooseX::AttributeHelpers'); } { @@ -15,7 +15,7 @@ BEGIN { use Moose; has 'string' => ( - traits => [qw/String/], + traits => [qw/MooseX::AttributeHelpers::Trait::String/], is => 'rw', isa => 'Str', default => sub { '' }, @@ -28,6 +28,10 @@ BEGIN { chop_string => 'chop', chomp_string => 'chomp', clear_string => 'clear', + exclaim => { append => [ '!' ]}, + capitalize_last => { replace => [ qr/(.)$/, sub { uc $1 } ]}, + invalid_number => { match => [ qr/\D/ ]}, + shift_chars => { substr => sub { $_[1]->($_[0], 0, $_[2], '') } }, }, ); } @@ -65,13 +69,34 @@ 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"); # check the meta .. my $string = $page->meta->get_attribute('string'); -does_ok($string, 'Moose::AttributeHelpers::Trait::String'); +does_ok($string, 'MooseX::AttributeHelpers::Trait::String'); is($string->helper_type, 'Str', '... got the expected helper type'); diff --git a/t/070_attribute_helpers/208_trait_bool.t b/t/070_attribute_helpers/208_trait_bool.t index 5462d90..4e66f4e 100644 --- a/t/070_attribute_helpers/208_trait_bool.t +++ b/t/070_attribute_helpers/208_trait_bool.t @@ -4,13 +4,13 @@ use strict; use warnings; use Test::More tests => 8; -use Moose::AttributeHelpers; +use MooseX::AttributeHelpers; { package Room; use Moose; has 'is_lit' => ( - traits => ['Bool'], + traits => ['MooseX::AttributeHelpers::Trait::Bool'], is => 'rw', isa => 'Bool', default => sub { 0 },