Commit | Line | Data |
e3c07b19 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
26a79215 |
6 | use Moose (); |
2c963694 |
7 | use Moose::Util::TypeConstraints; |
a28e50e4 |
8 | use Test::More; |
26a79215 |
9 | use Test::Exception; |
10 | use Test::Moose; |
e3c07b19 |
11 | |
12 | { |
26a79215 |
13 | my %handles = ( |
14 | illuminate => 'set', |
15 | darken => 'unset', |
16 | flip_switch => 'toggle', |
17 | is_dark => 'not', |
18 | ); |
19 | |
20 | my $name = 'Foo1'; |
21 | |
22 | sub build_class { |
23 | my %attr = @_; |
24 | |
25 | my $class = Moose::Meta::Class->create( |
26 | $name++, |
27 | superclasses => ['Moose::Object'], |
28 | ); |
29 | |
30 | $class->add_attribute( |
31 | is_lit => ( |
32 | traits => ['Bool'], |
33 | is => 'rw', |
34 | isa => 'Bool', |
35 | default => 0, |
36 | handles => \%handles, |
37 | clearer => '_clear_is_list', |
38 | %attr, |
39 | ), |
40 | ); |
41 | |
42 | return ( $class->name, \%handles ); |
43 | } |
44 | } |
45 | |
46 | { |
47 | run_tests(build_class); |
48 | run_tests( build_class( lazy => 1 ) ); |
cf0da4e2 |
49 | run_tests( build_class( trigger => sub { } ) ); |
2c963694 |
50 | |
51 | # Will force the inlining code to check the entire hashref when it is modified. |
52 | subtype 'MyBool', as 'Bool', where { 1 }; |
53 | |
54 | run_tests( build_class( isa => 'MyBool' ) ); |
55 | |
56 | coerce 'MyBool', from 'Bool', via { $_ }; |
57 | |
58 | run_tests( build_class( isa => 'MyBool', coerce => 1 ) ); |
e3c07b19 |
59 | } |
60 | |
26a79215 |
61 | sub run_tests { |
62 | my ( $class, $handles ) = @_; |
e3c07b19 |
63 | |
26a79215 |
64 | can_ok( $class, $_ ) for sort keys %{$handles}; |
e3c07b19 |
65 | |
26a79215 |
66 | with_immutable { |
67 | my $obj = $class->new; |
e3c07b19 |
68 | |
26a79215 |
69 | $obj->illuminate; |
70 | ok( $obj->is_lit, 'set is_lit to 1 using ->illuminate' ); |
71 | ok( !$obj->is_dark, 'check if is_dark does the right thing' ); |
72 | |
73 | throws_ok { $obj->illuminate(1) } |
74 | qr/Cannot call set with any arguments/, |
75 | 'set throws an error when an argument is passed'; |
76 | |
77 | $obj->darken; |
78 | ok( !$obj->is_lit, 'set is_lit to 0 using ->darken' ); |
79 | ok( $obj->is_dark, 'check if is_dark does the right thing' ); |
80 | |
81 | throws_ok { $obj->darken(1) } |
82 | qr/Cannot call unset with any arguments/, |
83 | 'unset throws an error when an argument is passed'; |
84 | |
85 | $obj->flip_switch; |
86 | ok( $obj->is_lit, 'toggle is_lit back to 1 using ->flip_switch' ); |
87 | ok( !$obj->is_dark, 'check if is_dark does the right thing' ); |
88 | |
89 | throws_ok { $obj->flip_switch(1) } |
90 | qr/Cannot call toggle with any arguments/, |
91 | 'toggle throws an error when an argument is passed'; |
92 | |
93 | $obj->flip_switch; |
94 | ok( !$obj->is_lit, |
95 | 'toggle is_lit back to 0 again using ->flip_switch' ); |
96 | ok( $obj->is_dark, 'check if is_dark does the right thing' ); |
97 | } |
98 | $class; |
99 | } |
e3c07b19 |
100 | |
a28e50e4 |
101 | done_testing; |