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