Commit | Line | Data |
e3c07b19 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
baf3ece5 |
6 | use Moose (); |
8b0c0c9d |
7 | use Test::Exception; |
a28e50e4 |
8 | use Test::More; |
8b0c0c9d |
9 | use Test::Moose; |
e3c07b19 |
10 | |
e3c07b19 |
11 | { |
24d9c065 |
12 | my %handles = ( |
13 | inc_counter => 'inc', |
14 | inc_counter_2 => [ inc => 2 ], |
15 | dec_counter => 'dec', |
16 | dec_counter_2 => [ dec => 2 ], |
17 | reset_counter => 'reset', |
18 | set_counter => 'set', |
19 | set_counter_42 => [ set => 42 ], |
20 | ); |
21 | |
baf3ece5 |
22 | my $name = 'Foo1'; |
23 | |
24 | sub build_class { |
25 | my %attr = @_; |
26 | |
27 | my $class = Moose::Meta::Class->create( |
28 | $name++, |
29 | superclasses => ['Moose::Object'], |
30 | ); |
31 | |
32 | $class->add_attribute( |
33 | counter => ( |
34 | traits => ['Counter'], |
35 | is => 'ro', |
36 | isa => 'Int', |
37 | default => 0, |
38 | handles => \%handles, |
39 | clearer => '_clear_counter', |
40 | %attr, |
41 | ), |
42 | ); |
43 | |
44 | return ( $class->name, \%handles ); |
45 | } |
46 | } |
8b0c0c9d |
47 | |
baf3ece5 |
48 | { |
49 | run_tests(build_class); |
24d9c065 |
50 | run_tests( build_class( lazy => 1 ) ); |
e3c07b19 |
51 | } |
52 | |
baf3ece5 |
53 | sub run_tests { |
54 | my ( $class, $handles ) = @_; |
55 | |
56 | can_ok( $class, $_ ) for sort keys %{$handles}; |
24d9c065 |
57 | |
baf3ece5 |
58 | with_immutable { |
59 | my $obj = $class->new(); |
60 | |
61 | is( $obj->counter, 0, '... got the default value' ); |
62 | |
63 | $obj->inc_counter; |
64 | is( $obj->counter, 1, '... got the incremented value' ); |
65 | |
66 | $obj->inc_counter; |
67 | is( $obj->counter, 2, '... got the incremented value (again)' ); |
8b0c0c9d |
68 | |
baf3ece5 |
69 | throws_ok { $obj->inc_counter( 1, 2 ) } |
70 | qr/Cannot call inc with more than 1 argument/, |
71 | 'inc throws an error when two arguments are passed'; |
8b0c0c9d |
72 | |
baf3ece5 |
73 | $obj->dec_counter; |
74 | is( $obj->counter, 1, '... got the decremented value' ); |
e3c07b19 |
75 | |
baf3ece5 |
76 | throws_ok { $obj->dec_counter( 1, 2 ) } |
77 | qr/Cannot call dec with more than 1 argument/, |
78 | 'dec throws an error when two arguments are passed'; |
e3c07b19 |
79 | |
baf3ece5 |
80 | $obj->reset_counter; |
81 | is( $obj->counter, 0, '... got the original value' ); |
e3c07b19 |
82 | |
baf3ece5 |
83 | throws_ok { $obj->reset_counter(2) } |
84 | qr/Cannot call reset with any arguments/, |
85 | 'reset throws an error when an argument is passed'; |
e3c07b19 |
86 | |
baf3ece5 |
87 | $obj->set_counter(5); |
88 | is( $obj->counter, 5, '... set the value' ); |
e3c07b19 |
89 | |
baf3ece5 |
90 | throws_ok { $obj->set_counter( 1, 2 ) } |
91 | qr/Cannot call set with more than 1 argument/, |
92 | 'set throws an error when two arguments are passed'; |
e3c07b19 |
93 | |
baf3ece5 |
94 | $obj->inc_counter(2); |
95 | is( $obj->counter, 7, '... increment by arg' ); |
e3c07b19 |
96 | |
baf3ece5 |
97 | $obj->dec_counter(5); |
98 | is( $obj->counter, 2, '... decrement by arg' ); |
59de9de4 |
99 | |
baf3ece5 |
100 | $obj->inc_counter_2; |
101 | is( $obj->counter, 4, '... curried increment' ); |
59de9de4 |
102 | |
baf3ece5 |
103 | $obj->dec_counter_2; |
104 | is( $obj->counter, 2, '... curried deccrement' ); |
59de9de4 |
105 | |
baf3ece5 |
106 | $obj->set_counter_42; |
107 | is( $obj->counter, 42, '... curried set' ); |
e3c07b19 |
108 | |
baf3ece5 |
109 | if ( $class->meta->get_attribute('counter')->is_lazy ) { |
110 | my $obj = $class->new; |
d50fc84a |
111 | |
baf3ece5 |
112 | $obj->inc_counter; |
113 | is( $obj->counter, 1, 'inc increments - with lazy default' ); |
8b0c0c9d |
114 | |
baf3ece5 |
115 | $obj->_clear_counter; |
8b0c0c9d |
116 | |
baf3ece5 |
117 | $obj->dec_counter; |
118 | is( $obj->counter, -1, 'dec decrements - with lazy default' ); |
119 | } |
120 | } |
121 | $class; |
8b0c0c9d |
122 | } |
e3c07b19 |
123 | |
a28e50e4 |
124 | done_testing; |