Commit | Line | Data |
e3c07b19 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
f1ae167f |
6 | use Moose (); |
2c963694 |
7 | use Moose::Util::TypeConstraints; |
f1ae167f |
8 | use Test::Exception; |
a28e50e4 |
9 | use Test::More; |
e3c07b19 |
10 | use Test::Moose; |
11 | |
e3c07b19 |
12 | { |
f1ae167f |
13 | my %handles = ( |
14 | abs => 'abs', |
15 | add => 'add', |
16 | inc => [ add => 1 ], |
17 | div => 'div', |
18 | cut_in_half => [ div => 2 ], |
19 | mod => 'mod', |
20 | odd => [ mod => 2 ], |
21 | mul => 'mul', |
22 | set => 'set', |
23 | sub => 'sub', |
24 | dec => [ sub => 1 ], |
e3c07b19 |
25 | ); |
f1ae167f |
26 | |
27 | my $name = 'Foo1'; |
28 | |
29 | sub build_class { |
30 | my %attr = @_; |
31 | |
32 | my $class = Moose::Meta::Class->create( |
33 | $name++, |
34 | superclasses => ['Moose::Object'], |
35 | ); |
36 | |
37 | $class->add_attribute( |
38 | integer => ( |
39 | traits => ['Number'], |
40 | is => 'ro', |
41 | isa => 'Int', |
42 | default => 5, |
43 | handles => \%handles, |
44 | clearer => '_clear_integer', |
45 | %attr, |
46 | ), |
47 | ); |
48 | |
49 | return ( $class->name, \%handles ); |
50 | } |
e3c07b19 |
51 | } |
52 | |
f1ae167f |
53 | { |
54 | run_tests(build_class); |
55 | run_tests( build_class( lazy => 1 ) ); |
cf0da4e2 |
56 | run_tests( build_class( trigger => sub { } ) ); |
2c963694 |
57 | |
58 | # Will force the inlining code to check the entire hashref when it is modified. |
59 | subtype 'MyInt', as 'Int', where { 1 }; |
60 | |
61 | run_tests( build_class( isa => 'MyInt' ) ); |
62 | |
63 | coerce 'MyInt', from 'Int', via { $_ }; |
64 | |
65 | run_tests( build_class( isa => 'MyInt', coerce => 1 ) ); |
f1ae167f |
66 | } |
e3c07b19 |
67 | |
f1ae167f |
68 | sub run_tests { |
69 | my ( $class, $handles ) = @_; |
e3c07b19 |
70 | |
f1ae167f |
71 | can_ok( $class, $_ ) for sort keys %{$handles}; |
e3c07b19 |
72 | |
f1ae167f |
73 | with_immutable { |
74 | my $obj = $class->new; |
e3c07b19 |
75 | |
f1ae167f |
76 | is( $obj->integer, 5, 'Default to five' ); |
e3c07b19 |
77 | |
f1ae167f |
78 | $obj->add(10); |
e3c07b19 |
79 | |
f1ae167f |
80 | is( $obj->integer, 15, 'Add ten for fithteen' ); |
e3c07b19 |
81 | |
167ec185 |
82 | throws_ok { $obj->add( 10, 2 ) } |
83 | qr/Cannot call add with more than 1 argument/, |
84 | 'add throws an error when 2 arguments are passed'; |
85 | |
f1ae167f |
86 | $obj->sub(3); |
e3c07b19 |
87 | |
f1ae167f |
88 | is( $obj->integer, 12, 'Subtract three for 12' ); |
e3c07b19 |
89 | |
167ec185 |
90 | throws_ok { $obj->sub( 10, 2 ) } |
91 | qr/Cannot call sub with more than 1 argument/, |
92 | 'sub throws an error when 2 arguments are passed'; |
93 | |
f1ae167f |
94 | $obj->set(10); |
e3c07b19 |
95 | |
f1ae167f |
96 | is( $obj->integer, 10, 'Set to ten' ); |
e3c07b19 |
97 | |
167ec185 |
98 | throws_ok { $obj->set( 10, 2 ) } |
99 | qr/Cannot call set with more than 1 argument/, |
100 | 'set throws an error when 2 arguments are passed'; |
101 | |
f1ae167f |
102 | $obj->div(2); |
e3c07b19 |
103 | |
f1ae167f |
104 | is( $obj->integer, 5, 'divide by 2' ); |
e3c07b19 |
105 | |
167ec185 |
106 | throws_ok { $obj->div( 10, 2 ) } |
107 | qr/Cannot call div with more than 1 argument/, |
108 | 'div throws an error when 2 arguments are passed'; |
109 | |
f1ae167f |
110 | $obj->mul(2); |
e3c07b19 |
111 | |
f1ae167f |
112 | is( $obj->integer, 10, 'multiplied by 2' ); |
e3c07b19 |
113 | |
167ec185 |
114 | throws_ok { $obj->mul( 10, 2 ) } |
115 | qr/Cannot call mul with more than 1 argument/, |
116 | 'mul throws an error when 2 arguments are passed'; |
117 | |
f1ae167f |
118 | $obj->mod(2); |
e3c07b19 |
119 | |
f1ae167f |
120 | is( $obj->integer, 0, 'Mod by 2' ); |
e3c07b19 |
121 | |
167ec185 |
122 | throws_ok { $obj->mod( 10, 2 ) } |
123 | qr/Cannot call mod with more than 1 argument/, |
124 | 'mod throws an error when 2 arguments are passed'; |
125 | |
f1ae167f |
126 | $obj->set(7); |
e3c07b19 |
127 | |
f1ae167f |
128 | $obj->mod(5); |
e3c07b19 |
129 | |
f1ae167f |
130 | is( $obj->integer, 2, 'Mod by 5' ); |
e3c07b19 |
131 | |
f1ae167f |
132 | $obj->set(-1); |
e3c07b19 |
133 | |
f1ae167f |
134 | $obj->abs; |
59de9de4 |
135 | |
167ec185 |
136 | throws_ok { $obj->abs(10) } |
137 | qr/Cannot call abs with any arguments/, |
138 | 'abs throws an error when an argument is passed'; |
139 | |
f1ae167f |
140 | is( $obj->integer, 1, 'abs 1' ); |
59de9de4 |
141 | |
f1ae167f |
142 | $obj->set(12); |
59de9de4 |
143 | |
f1ae167f |
144 | $obj->inc; |
59de9de4 |
145 | |
f1ae167f |
146 | is( $obj->integer, 13, 'inc 12' ); |
59de9de4 |
147 | |
f1ae167f |
148 | $obj->dec; |
e3c07b19 |
149 | |
f1ae167f |
150 | is( $obj->integer, 12, 'dec 13' ); |
d50fc84a |
151 | |
f1ae167f |
152 | if ( $class->meta->get_attribute('integer')->is_lazy ) { |
153 | my $obj = $class->new; |
154 | |
155 | $obj->add(2); |
156 | |
157 | is( $obj->integer, 7, 'add with lazy default' ); |
158 | |
159 | $obj->_clear_integer; |
160 | |
161 | $obj->mod(2); |
162 | |
163 | is( $obj->integer, 1, 'mod with lazy default' ); |
164 | } |
165 | } |
166 | $class; |
167 | } |
e3c07b19 |
168 | |
a28e50e4 |
169 | done_testing; |