From: Dave Rolsky Date: Sat, 25 Sep 2010 18:32:39 +0000 (-0500) Subject: More tests for Hash trait X-Git-Tag: 1.15~101 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1c08fd75255a98e8cadf8c8e5d4a147cb330c336;p=gitmo%2FMoose.git More tests for Hash trait --- diff --git a/t/070_native_traits/003_trait_hash.t b/t/070_native_traits/003_trait_hash.t index 1b621b5..824f718 100644 --- a/t/070_native_traits/003_trait_hash.t +++ b/t/070_native_traits/003_trait_hash.t @@ -3,183 +3,225 @@ use strict; use warnings; -use Test::More; +use Moose (); use Test::Exception; -use Test::Moose 'does_ok'; +use Test::More; +use Test::Moose; { - package Stuff; - use Moose; - - has 'options' => ( - traits => ['Hash'], - is => 'ro', - isa => 'HashRef[Str]', - default => sub { {} }, - handles => { - 'set_option' => 'set', - 'get_option' => 'get', - 'has_no_options' => 'is_empty', - 'num_options' => 'count', - 'clear_options' => 'clear', - 'delete_option' => 'delete', - 'has_option' => 'exists', - 'is_defined' => 'defined', - 'option_accessor' => 'accessor', - 'key_value' => 'kv', - 'options_elements' => 'elements', - 'quantity' => [ accessor => 'quantity' ], - }, + my %handles = ( + option_accessor => 'accessor', + quantity => [ accessor => 'quantity' ], + clear_options => 'clear', + num_options => 'count', + delete_option => 'delete', + is_defined => 'defined', + options_elements => 'elements', + has_option => 'exists', + get_option => 'get', + has_no_options => 'is_empty', + key_value => 'kv', + set_option => 'set', ); -} - -my $stuff = Stuff->new(); -isa_ok( $stuff, 'Stuff' ); - -can_ok( $stuff, $_ ) for qw[ - set_option - get_option - has_no_options - num_options - delete_option - clear_options - is_defined - has_option - quantity - option_accessor -]; - -ok( $stuff->has_no_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_no_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 { - $stuff->set_option( bar => 'baz' ); -} -'... set the option okay'; - -is( $stuff->num_options, 2, '... we have 2 option(s)' ); -is_deeply( $stuff->options, { foo => 'bar', bar => 'baz' }, - '... got more options now' ); - -is( $stuff->get_option('foo'), 'bar', '... got the right option' ); - -is_deeply( [ $stuff->get_option(qw(foo bar)) ], [qw(bar baz)], - "get multiple options at once" ); - -is( scalar($stuff->get_option(qw( foo bar) )), "baz", - '... got last option in scalar context'); -lives_ok { - $stuff->set_option( oink => "blah", xxy => "flop" ); + my $name = 'Foo1'; + + sub build_class { + my %attr = @_; + + my $class = Moose::Meta::Class->create( + $name++, + superclasses => ['Moose::Object'], + ); + + $class->add_attribute( + options => ( + traits => ['Hash'], + is => 'ro', + isa => 'HashRef[Str]', + default => sub { {} }, + handles => \%handles, + clearer => '_clear_options', + %attr, + ), + ); + + return ( $class->name, \%handles ); + } } -'... set the option okay'; -is( $stuff->num_options, 4, "4 options" ); -is_deeply( [ $stuff->get_option(qw(foo bar oink xxy)) ], - [qw(bar baz blah flop)], "get multiple options at once" ); - -lives_ok { - $stuff->delete_option('bar'); -} -'... deleted the option okay'; - -lives_ok { - $stuff->delete_option('oink','xxy'); -} -'... deleted multiple option okay'; - -is( $stuff->num_options, 1, '... we have 1 option(s)' ); -is_deeply( $stuff->options, { foo => 'bar' }, '... got more options now' ); - -$stuff->clear_options; - -is_deeply( $stuff->options, {}, "... cleared options" ); - -lives_ok { - $stuff->quantity(4); +{ + run_tests(build_class); + run_tests( build_class( lazy => 1, default => sub { { x => 1 } } ) ); } -'... 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' ); +sub run_tests { + my ( $class, $handles ) = @_; -lives_ok { - Stuff->new( options => { foo => 'BAR' } ); -} -'... good constructor params'; - -## check some errors + can_ok( $class, $_ ) for sort keys %{$handles}; -dies_ok { - $stuff->set_option( bar => {} ); -} -'... could not add a hash ref where an string is expected'; + with_immutable { + my $obj = $class->new( options => {} ); -dies_ok { - Stuff->new( options => { foo => [] } ); + ok( $obj->has_no_options, '... we have no options' ); + is( $obj->num_options, 0, '... we have no options' ); + + is_deeply( $obj->options, {}, '... no options yet' ); + ok( !$obj->has_option('foo'), '... we have no foo option' ); + + lives_ok { + $obj->set_option( foo => 'bar' ); + } + '... set the option okay'; + + ok( $obj->is_defined('foo'), '... foo is defined' ); + + ok( !$obj->has_no_options, '... we have options' ); + is( $obj->num_options, 1, '... we have 1 option(s)' ); + ok( $obj->has_option('foo'), '... we have a foo option' ); + is_deeply( $obj->options, { foo => 'bar' }, '... got options now' ); + + lives_ok { + $obj->set_option( bar => 'baz' ); + } + '... set the option okay'; + + is( $obj->num_options, 2, '... we have 2 option(s)' ); + is_deeply( + $obj->options, { foo => 'bar', bar => 'baz' }, + '... got more options now' + ); + + is( $obj->get_option('foo'), 'bar', '... got the right option' ); + + is_deeply( + [ $obj->get_option(qw(foo bar)) ], [qw(bar baz)], + "get multiple options at once" + ); + + is( + scalar( $obj->get_option(qw( foo bar)) ), "baz", + '... got last option in scalar context' + ); + + lives_ok { + $obj->set_option( oink => "blah", xxy => "flop" ); + } + '... set the option okay'; + + is( $obj->num_options, 4, "4 options" ); + is_deeply( + [ $obj->get_option(qw(foo bar oink xxy)) ], + [qw(bar baz blah flop)], "get multiple options at once" + ); + + lives_ok { + $obj->delete_option('bar'); + } + '... deleted the option okay'; + + lives_ok { + $obj->delete_option( 'oink', 'xxy' ); + } + '... deleted multiple option okay'; + + is( $obj->num_options, 1, '... we have 1 option(s)' ); + is_deeply( + $obj->options, { foo => 'bar' }, + '... got more options now' + ); + + $obj->clear_options; + + is_deeply( $obj->options, {}, "... cleared options" ); + + lives_ok { + $obj->quantity(4); + } + '... options added okay with defaults'; + + is( $obj->quantity, 4, 'reader part of curried accessor works' ); + + is_deeply( + $obj->options, { quantity => 4 }, + '... returns what we expect' + ); + + lives_ok { + $class->new( options => { foo => 'BAR' } ); + } + '... good constructor params'; + + dies_ok { + $obj->set_option( bar => {} ); + } + '... could not add a hash ref where an string is expected'; + + dies_ok { + $class->new( options => { foo => [] } ); + } + '... bad constructor params'; + + $obj->set_option( oink => "blah", xxy => "flop" ); + my @key_value = sort { $a->[0] cmp $b->[0] } $obj->key_value; + is_deeply( + \@key_value, + [ + sort { $a->[0] cmp $b->[0] }[ 'xxy', 'flop' ], + [ 'quantity', 4 ], + [ 'oink', 'blah' ] + ], + '... got the right key value pairs' + ) + or do { + require Data::Dumper; + diag( Data::Dumper::Dumper( \@key_value ) ); + }; + + my %options_elements = $obj->options_elements; + is_deeply( + \%options_elements, { + 'oink' => 'blah', + 'quantity' => 4, + 'xxy' => 'flop' + }, + '... got the right hash elements' + ); + + if ( $class->meta->get_attribute('options')->is_lazy ) { + my $obj = $class->new; + + $obj->set_option( y => 2 ); + + is_deeply( + $obj->options, { x => 1, y => 2 }, + 'set_option with lazy default' + ); + + $obj->_clear_options; + + ok( + $obj->has_option('x'), + 'key for x exists - lazy default' + ); + + $obj->_clear_options; + + ok( + $obj->is_defined('x'), + 'key for x is defined - lazy default' + ); + + $obj->_clear_options; + + is_deeply( + [ $obj->key_value ], + [ [ x => 1 ] ], + 'kv returns lazy default' + ); + } + } + $class; } -'... bad constructor params'; - -## test the meta - -my $options = $stuff->meta->get_attribute('options'); -does_ok( $options, 'Moose::Meta::Attribute::Native::Trait::Hash' ); - -is_deeply( - $options->handles, - { - 'set_option' => 'set', - 'get_option' => 'get', - 'has_no_options' => 'is_empty', - 'num_options' => 'count', - 'clear_options' => 'clear', - 'delete_option' => 'delete', - 'has_option' => 'exists', - 'is_defined' => 'defined', - 'option_accessor' => 'accessor', - 'key_value' => 'kv', - 'options_elements' => 'elements', - 'quantity' => [ accessor => 'quantity' ], - }, - '... got the right handles mapping' -); - -is( $options->type_constraint->type_parameter, 'Str', - '... got the right container type' ); - -$stuff->set_option( oink => "blah", xxy => "flop" ); -my @key_value = sort{ $a->[0] cmp $b->[0] } $stuff->key_value; -is_deeply( - \@key_value, - [ sort{ $a->[0] cmp $b->[0] } [ 'xxy', 'flop' ], [ 'quantity', 4 ], [ 'oink', 'blah' ] ], - '... got the right key value pairs' -) or do{ require Data::Dumper; diag(Data::Dumper::Dumper(\@key_value)) }; - -my %options_elements = $stuff->options_elements; -is_deeply( - \%options_elements, - { - 'oink' => 'blah', - 'quantity' => 4, - 'xxy' => 'flop' - }, - '... got the right hash elements' -); done_testing;