9 use Moose::Util::TypeConstraints;
10 use NoInlineAttribute;
18 inc_counter_2 => [ inc => 2 ],
20 dec_counter_2 => [ dec => 2 ],
21 reset_counter => 'reset',
23 set_counter_42 => [ set => 42 ],
31 my $class = Moose::Meta::Class->create(
33 superclasses => ['Moose::Object'],
36 my @traits = 'Counter';
37 push @traits, 'NoInlineAttribute'
38 if delete $attr{no_inline};
40 $class->add_attribute(
47 clearer => '_clear_counter',
52 return ( $class->name, \%handles );
57 run_tests(build_class);
58 run_tests( build_class( lazy => 1 ) );
59 run_tests( build_class( trigger => sub { } ) );
60 run_tests( build_class( no_inline => 1 ) );
62 # Will force the inlining code to check the entire hashref when it is modified.
63 subtype 'MyInt', as 'Int', where { 1 };
65 run_tests( build_class( isa => 'MyInt' ) );
67 coerce 'MyInt', from 'Int', via { $_ };
69 run_tests( build_class( isa => 'MyInt', coerce => 1 ) );
73 my ( $class, $handles ) = @_;
75 can_ok( $class, $_ ) for sort keys %{$handles};
78 my $obj = $class->new();
80 is( $obj->counter, 0, '... got the default value' );
82 is( $obj->inc_counter, 1, 'inc returns new value' );
83 is( $obj->counter, 1, '... got the incremented value' );
85 is( $obj->inc_counter, 2, 'inc returns new value' );
86 is( $obj->counter, 2, '... got the incremented value (again)' );
88 like( exception { $obj->inc_counter( 1, 2 ) }, qr/Cannot call inc with more than 1 argument/, 'inc throws an error when two arguments are passed' );
90 is( $obj->dec_counter, 1, 'dec returns new value' );
91 is( $obj->counter, 1, '... got the decremented value' );
93 like( exception { $obj->dec_counter( 1, 2 ) }, qr/Cannot call dec with more than 1 argument/, 'dec throws an error when two arguments are passed' );
95 is( $obj->reset_counter, 0, 'reset returns new value' );
96 is( $obj->counter, 0, '... got the original value' );
98 like( exception { $obj->reset_counter(2) }, qr/Cannot call reset with any arguments/, 'reset throws an error when an argument is passed' );
100 is( $obj->set_counter(5), 5, 'set returns new value' );
101 is( $obj->counter, 5, '... set the value' );
103 like( exception { $obj->set_counter( 1, 2 ) }, qr/Cannot call set with more than 1 argument/, 'set throws an error when two arguments are passed' );
105 $obj->inc_counter(2);
106 is( $obj->counter, 7, '... increment by arg' );
108 $obj->dec_counter(5);
109 is( $obj->counter, 2, '... decrement by arg' );
112 is( $obj->counter, 4, '... curried increment' );
115 is( $obj->counter, 2, '... curried deccrement' );
117 $obj->set_counter_42;
118 is( $obj->counter, 42, '... curried set' );
120 if ( $class->meta->get_attribute('counter')->is_lazy ) {
121 my $obj = $class->new;
124 is( $obj->counter, 1, 'inc increments - with lazy default' );
126 $obj->_clear_counter;
129 is( $obj->counter, -1, 'dec decrements - with lazy default' );
140 traits => ['Counter'],
143 builder => '_builder',
145 reset_nonlazy => 'reset',
150 traits => ['Counter'],
154 builder => '_builder',
156 reset_lazy => 'reset',
163 for my $attr ('lazy', 'nonlazy') {
164 my $obj = WithBuilder->new;
165 is($obj->$attr, 1, "built properly");
167 is($obj->$attr, 0, "can be manually set");
168 $obj->${\"reset_$attr"};
169 is($obj->$attr, 1, "reset resets it to its default value");