7 use Moose::Util::TypeConstraints;
14 option_accessor => 'accessor',
15 quantity => [ accessor => 'quantity' ],
16 clear_options => 'clear',
17 num_options => 'count',
18 delete_option => 'delete',
19 is_defined => 'defined',
20 options_elements => 'elements',
21 has_option => 'exists',
23 has_no_options => 'is_empty',
33 my $class = Moose::Meta::Class->create(
35 superclasses => ['Moose::Object'],
38 $class->add_attribute(
42 isa => 'HashRef[Str]',
43 default => sub { {} },
45 clearer => '_clear_options',
50 return ( $class->name, \%handles );
55 run_tests(build_class);
56 run_tests( build_class( lazy => 1, default => sub { { x => 1 } } ) );
58 # Will force the inlining code to check the entire hashref when it is modified.
59 subtype 'MyHashRef', as 'HashRef[Str]', where { 1 };
61 run_tests( build_class( isa => 'MyHashRef' ) );
63 coerce 'MyHashRef', from 'HashRef', via { $_ };
65 run_tests( build_class( isa => 'MyHashRef', coerce => 1 ) );
69 my ( $class, $handles ) = @_;
71 can_ok( $class, $_ ) for sort keys %{$handles};
74 my $obj = $class->new( options => {} );
76 ok( $obj->has_no_options, '... we have no options' );
77 is( $obj->num_options, 0, '... we have no options' );
79 is_deeply( $obj->options, {}, '... no options yet' );
80 ok( !$obj->has_option('foo'), '... we have no foo option' );
83 $obj->set_option( foo => 'bar' );
85 '... set the option okay';
87 ok( $obj->is_defined('foo'), '... foo is defined' );
89 ok( !$obj->has_no_options, '... we have options' );
90 is( $obj->num_options, 1, '... we have 1 option(s)' );
91 ok( $obj->has_option('foo'), '... we have a foo option' );
92 is_deeply( $obj->options, { foo => 'bar' }, '... got options now' );
95 $obj->set_option( bar => 'baz' );
97 '... set the option okay';
99 is( $obj->num_options, 2, '... we have 2 option(s)' );
101 $obj->options, { foo => 'bar', bar => 'baz' },
102 '... got more options now'
105 is( $obj->get_option('foo'), 'bar', '... got the right option' );
108 [ $obj->get_option(qw(foo bar)) ], [qw(bar baz)],
109 "get multiple options at once"
113 scalar( $obj->get_option(qw( foo bar)) ), "baz",
114 '... got last option in scalar context'
118 $obj->set_option( oink => "blah", xxy => "flop" );
120 '... set the option okay';
122 is( $obj->num_options, 4, "4 options" );
124 [ $obj->get_option(qw(foo bar oink xxy)) ],
125 [qw(bar baz blah flop)], "get multiple options at once"
129 $obj->delete_option('bar');
131 '... deleted the option okay';
134 $obj->delete_option( 'oink', 'xxy' );
136 '... deleted multiple option okay';
138 is( $obj->num_options, 1, '... we have 1 option(s)' );
140 $obj->options, { foo => 'bar' },
141 '... got more options now'
146 is_deeply( $obj->options, {}, "... cleared options" );
151 '... options added okay with defaults';
153 is( $obj->quantity, 4, 'reader part of curried accessor works' );
156 $obj->options, { quantity => 4 },
157 '... returns what we expect'
161 $class->new( options => { foo => 'BAR' } );
163 '... good constructor params';
166 $obj->set_option( bar => {} );
168 '... could not add a hash ref where an string is expected';
171 $class->new( options => { foo => [] } );
173 '... bad constructor params';
175 $obj->set_option( oink => "blah", xxy => "flop" );
176 my @key_value = sort { $a->[0] cmp $b->[0] } $obj->key_value;
180 sort { $a->[0] cmp $b->[0] }[ 'xxy', 'flop' ],
184 '... got the right key value pairs'
187 require Data::Dumper;
188 diag( Data::Dumper::Dumper( \@key_value ) );
191 my %options_elements = $obj->options_elements;
193 \%options_elements, {
198 '... got the right hash elements'
201 if ( $class->meta->get_attribute('options')->is_lazy ) {
202 my $obj = $class->new;
204 $obj->set_option( y => 2 );
207 $obj->options, { x => 1, y => 2 },
208 'set_option with lazy default'
211 $obj->_clear_options;
214 $obj->has_option('x'),
215 'key for x exists - lazy default'
218 $obj->_clear_options;
221 $obj->is_defined('x'),
222 'key for x is defined - lazy default'
225 $obj->_clear_options;
230 'kv returns lazy default'