Commit | Line | Data |
e3c07b19 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
8b9641b8 |
6 | use lib 't/lib'; |
7 | |
baf3ece5 |
8 | use Moose (); |
2c963694 |
9 | use Moose::Util::TypeConstraints; |
8b9641b8 |
10 | use NoInlineAttribute; |
b10dde3a |
11 | use Test::Fatal; |
a28e50e4 |
12 | use Test::More; |
8b0c0c9d |
13 | use Test::Moose; |
e3c07b19 |
14 | |
e3c07b19 |
15 | { |
24d9c065 |
16 | my %handles = ( |
17 | inc_counter => 'inc', |
18 | inc_counter_2 => [ inc => 2 ], |
19 | dec_counter => 'dec', |
20 | dec_counter_2 => [ dec => 2 ], |
21 | reset_counter => 'reset', |
22 | set_counter => 'set', |
23 | set_counter_42 => [ set => 42 ], |
24 | ); |
25 | |
baf3ece5 |
26 | my $name = 'Foo1'; |
27 | |
28 | sub build_class { |
29 | my %attr = @_; |
30 | |
31 | my $class = Moose::Meta::Class->create( |
32 | $name++, |
33 | superclasses => ['Moose::Object'], |
34 | ); |
35 | |
8b9641b8 |
36 | my @traits = 'Counter'; |
37 | push @traits, 'NoInlineAttribute' |
38 | if delete $attr{no_inline}; |
39 | |
baf3ece5 |
40 | $class->add_attribute( |
41 | counter => ( |
8b9641b8 |
42 | traits => \@traits, |
baf3ece5 |
43 | is => 'ro', |
44 | isa => 'Int', |
45 | default => 0, |
46 | handles => \%handles, |
47 | clearer => '_clear_counter', |
48 | %attr, |
49 | ), |
50 | ); |
51 | |
52 | return ( $class->name, \%handles ); |
53 | } |
54 | } |
8b0c0c9d |
55 | |
baf3ece5 |
56 | { |
57 | run_tests(build_class); |
24d9c065 |
58 | run_tests( build_class( lazy => 1 ) ); |
cf0da4e2 |
59 | run_tests( build_class( trigger => sub { } ) ); |
8b9641b8 |
60 | run_tests( build_class( no_inline => 1 ) ); |
2c963694 |
61 | |
62 | # Will force the inlining code to check the entire hashref when it is modified. |
63 | subtype 'MyInt', as 'Int', where { 1 }; |
64 | |
65 | run_tests( build_class( isa => 'MyInt' ) ); |
66 | |
67 | coerce 'MyInt', from 'Int', via { $_ }; |
68 | |
69 | run_tests( build_class( isa => 'MyInt', coerce => 1 ) ); |
e3c07b19 |
70 | } |
71 | |
baf3ece5 |
72 | sub run_tests { |
73 | my ( $class, $handles ) = @_; |
74 | |
75 | can_ok( $class, $_ ) for sort keys %{$handles}; |
24d9c065 |
76 | |
baf3ece5 |
77 | with_immutable { |
78 | my $obj = $class->new(); |
79 | |
80 | is( $obj->counter, 0, '... got the default value' ); |
81 | |
7f5ec80d |
82 | is( $obj->inc_counter, 1, 'inc returns new value' ); |
baf3ece5 |
83 | is( $obj->counter, 1, '... got the incremented value' ); |
84 | |
7f5ec80d |
85 | is( $obj->inc_counter, 2, 'inc returns new value' ); |
baf3ece5 |
86 | is( $obj->counter, 2, '... got the incremented value (again)' ); |
8b0c0c9d |
87 | |
b10dde3a |
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' ); |
8b0c0c9d |
89 | |
7f5ec80d |
90 | is( $obj->dec_counter, 1, 'dec returns new value' ); |
baf3ece5 |
91 | is( $obj->counter, 1, '... got the decremented value' ); |
e3c07b19 |
92 | |
b10dde3a |
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' ); |
e3c07b19 |
94 | |
7f5ec80d |
95 | is( $obj->reset_counter, 0, 'reset returns new value' ); |
baf3ece5 |
96 | is( $obj->counter, 0, '... got the original value' ); |
e3c07b19 |
97 | |
b10dde3a |
98 | like( exception { $obj->reset_counter(2) }, qr/Cannot call reset with any arguments/, 'reset throws an error when an argument is passed' ); |
e3c07b19 |
99 | |
7f5ec80d |
100 | is( $obj->set_counter(5), 5, 'set returns new value' ); |
baf3ece5 |
101 | is( $obj->counter, 5, '... set the value' ); |
e3c07b19 |
102 | |
b10dde3a |
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' ); |
e3c07b19 |
104 | |
baf3ece5 |
105 | $obj->inc_counter(2); |
106 | is( $obj->counter, 7, '... increment by arg' ); |
e3c07b19 |
107 | |
baf3ece5 |
108 | $obj->dec_counter(5); |
109 | is( $obj->counter, 2, '... decrement by arg' ); |
59de9de4 |
110 | |
baf3ece5 |
111 | $obj->inc_counter_2; |
112 | is( $obj->counter, 4, '... curried increment' ); |
59de9de4 |
113 | |
baf3ece5 |
114 | $obj->dec_counter_2; |
115 | is( $obj->counter, 2, '... curried deccrement' ); |
59de9de4 |
116 | |
baf3ece5 |
117 | $obj->set_counter_42; |
118 | is( $obj->counter, 42, '... curried set' ); |
e3c07b19 |
119 | |
baf3ece5 |
120 | if ( $class->meta->get_attribute('counter')->is_lazy ) { |
121 | my $obj = $class->new; |
d50fc84a |
122 | |
baf3ece5 |
123 | $obj->inc_counter; |
124 | is( $obj->counter, 1, 'inc increments - with lazy default' ); |
8b0c0c9d |
125 | |
baf3ece5 |
126 | $obj->_clear_counter; |
8b0c0c9d |
127 | |
baf3ece5 |
128 | $obj->dec_counter; |
129 | is( $obj->counter, -1, 'dec decrements - with lazy default' ); |
130 | } |
131 | } |
132 | $class; |
8b0c0c9d |
133 | } |
e3c07b19 |
134 | |
dccb4cc6 |
135 | { |
136 | package WithBuilder; |
137 | use Moose; |
138 | |
139 | has nonlazy => ( |
140 | traits => ['Counter'], |
141 | is => 'rw', |
142 | isa => 'Int', |
143 | builder => '_builder', |
144 | handles => { |
145 | reset_nonlazy => 'reset', |
146 | }, |
147 | ); |
148 | |
149 | has lazy => ( |
150 | traits => ['Counter'], |
151 | is => 'rw', |
152 | isa => 'Int', |
153 | lazy => 1, |
154 | builder => '_builder', |
155 | handles => { |
156 | reset_lazy => 'reset', |
157 | }, |
158 | ); |
159 | |
160 | sub _builder { 1 } |
161 | } |
162 | |
163 | for my $attr ('lazy', 'nonlazy') { |
164 | my $obj = WithBuilder->new; |
165 | is($obj->$attr, 1, "built properly"); |
166 | $obj->$attr(0); |
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"); |
170 | } |
171 | |
a28e50e4 |
172 | done_testing; |