Commit | Line | Data |
6d377074 |
1 | use strictures 1; |
2 | use Test::More; |
3 | use Test::Fatal; |
4 | |
5 | sub run_for { |
6 | my $class = shift; |
7 | |
8 | my $obj = $class->new(less_than_three => 1); |
9 | |
e57f338d |
10 | is($obj->less_than_three, 1, "initial value set (${class})"); |
6d377074 |
11 | |
12 | like( |
13 | exception { $obj->less_than_three(4) }, |
bc65d744 |
14 | qr/isa check for "less_than_three" failed: 4 is not less than three/, |
15 | "exception thrown on bad set (${class})" |
6d377074 |
16 | ); |
17 | |
e57f338d |
18 | is($obj->less_than_three, 1, "initial value remains after bad set (${class})"); |
6d377074 |
19 | |
20 | my $ret; |
21 | |
22 | is( |
23 | exception { $ret = $obj->less_than_three(2) }, |
e57f338d |
24 | undef, "no exception on correct set (${class})" |
6d377074 |
25 | ); |
26 | |
e57f338d |
27 | is($ret, 2, "correct setter return (${class})"); |
28 | is($obj->less_than_three, 2, "correct getter return (${class})"); |
6d377074 |
29 | |
e57f338d |
30 | is(exception { $class->new }, undef, "no exception with no value (${class})"); |
6d377074 |
31 | like( |
32 | exception { $class->new(less_than_three => 12) }, |
bc65d744 |
33 | qr/isa check for "less_than_three" failed: 12 is not less than three/, |
e57f338d |
34 | "exception thrown on bad constructor arg (${class})" |
6d377074 |
35 | ); |
36 | } |
37 | |
38 | { |
39 | package Foo; |
40 | |
b1eebd55 |
41 | use Moo; |
6d377074 |
42 | |
43 | has less_than_three => ( |
44 | is => 'rw', |
45 | isa => sub { die "$_[0] is not less than three" unless $_[0] < 3 } |
46 | ); |
47 | } |
48 | |
49 | run_for 'Foo'; |
50 | |
51 | { |
52 | package Bar; |
53 | |
54 | use Sub::Quote; |
b1eebd55 |
55 | use Moo; |
6d377074 |
56 | |
57 | has less_than_three => ( |
58 | is => 'rw', |
e57f338d |
59 | isa => quote_sub q{ |
60 | my ($x) = @_; |
61 | die "$x is not less than three" unless $x < 3 |
62 | } |
6d377074 |
63 | ); |
64 | } |
65 | |
66 | run_for 'Bar'; |
67 | |
68 | { |
69 | package Baz; |
70 | |
71 | use Sub::Quote; |
b1eebd55 |
72 | use Moo; |
6d377074 |
73 | |
74 | has less_than_three => ( |
75 | is => 'rw', |
76 | isa => quote_sub( |
e57f338d |
77 | q{ |
78 | my ($value) = @_; |
79 | die "$value is not less than ${word}" unless $value < $limit |
80 | }, |
6d377074 |
81 | { '$limit' => \3, '$word' => \'three' } |
82 | ) |
83 | ); |
84 | } |
85 | |
86 | run_for 'Baz'; |
87 | |
159d9c5b |
88 | my $lt3; |
89 | |
ef21bc32 |
90 | { |
91 | package LazyFoo; |
92 | |
159d9c5b |
93 | use Sub::Quote; |
ef21bc32 |
94 | use Moo; |
95 | |
96 | has less_than_three => ( |
97 | is => 'lazy', |
159d9c5b |
98 | isa => quote_sub(q{ die "$_[0] is not less than three" unless $_[0] < 3 }) |
ef21bc32 |
99 | ); |
100 | |
159d9c5b |
101 | sub _build_less_than_three { $lt3 } |
ef21bc32 |
102 | } |
103 | |
159d9c5b |
104 | $lt3 = 4; |
105 | |
5801a52d |
106 | my $lazyfoo = LazyFoo->new; |
ef21bc32 |
107 | like( |
5801a52d |
108 | exception { $lazyfoo->less_than_three }, |
bc65d744 |
109 | qr/isa check for "less_than_three" failed: 4 is not less than three/, |
ef21bc32 |
110 | "exception thrown on bad builder return value (LazyFoo)" |
111 | ); |
112 | |
159d9c5b |
113 | $lt3 = 2; |
114 | |
5801a52d |
115 | is( |
116 | exception { $lazyfoo->less_than_three }, |
117 | undef, |
118 | 'Corrected builder value on existing object returned ok' |
119 | ); |
120 | |
159d9c5b |
121 | is(LazyFoo->new->less_than_three, 2, 'Correct builder value returned ok'); |
122 | |
0c0971f5 |
123 | { |
124 | package Fizz; |
125 | |
126 | use Moo; |
127 | |
128 | has attr1 => ( |
129 | is => 'ro', |
130 | isa => sub { |
131 | no warnings 'once'; |
132 | my $attr = $Method::Generate::Accessor::CurrentAttribute; |
133 | die bless [@$attr{'name', 'init_arg', 'step'}], 'MyException'; |
134 | }, |
135 | init_arg => 'attr_1', |
136 | ); |
137 | } |
138 | |
139 | my $e = exception { Fizz->new(attr_1 => 5) }; |
140 | is( |
141 | ref($e), |
142 | 'MyException', |
143 | 'Exception objects passed though correctly', |
144 | ); |
145 | |
146 | is($e->[0], 'attr1', 'attribute name available in isa check'); |
147 | is($e->[1], 'attr_1', 'attribute init_arg available in isa check'); |
148 | is($e->[2], 'isa check', 'step available in isa check'); |
149 | |
150 | { |
151 | my $called; |
152 | local $SIG{__DIE__} = sub { $called++; die $_[0] }; |
153 | my $e = exception { Fizz->new(attr_1 => 5) }; |
154 | is($called, 1, '__DIE__ handler called if set') |
155 | } |
156 | |
6d377074 |
157 | done_testing; |