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) }, |
e57f338d |
14 | qr/4 is not less than three/, "exception thrown on bad set (${class})" |
6d377074 |
15 | ); |
16 | |
e57f338d |
17 | is($obj->less_than_three, 1, "initial value remains after bad set (${class})"); |
6d377074 |
18 | |
19 | my $ret; |
20 | |
21 | is( |
22 | exception { $ret = $obj->less_than_three(2) }, |
e57f338d |
23 | undef, "no exception on correct set (${class})" |
6d377074 |
24 | ); |
25 | |
e57f338d |
26 | is($ret, 2, "correct setter return (${class})"); |
27 | is($obj->less_than_three, 2, "correct getter return (${class})"); |
6d377074 |
28 | |
e57f338d |
29 | is(exception { $class->new }, undef, "no exception with no value (${class})"); |
6d377074 |
30 | like( |
31 | exception { $class->new(less_than_three => 12) }, |
e57f338d |
32 | qr/12 is not less than three/, |
33 | "exception thrown on bad constructor arg (${class})" |
6d377074 |
34 | ); |
35 | } |
36 | |
37 | { |
38 | package Foo; |
39 | |
b1eebd55 |
40 | use Moo; |
6d377074 |
41 | |
42 | has less_than_three => ( |
43 | is => 'rw', |
44 | isa => sub { die "$_[0] is not less than three" unless $_[0] < 3 } |
45 | ); |
46 | } |
47 | |
48 | run_for 'Foo'; |
49 | |
50 | { |
51 | package Bar; |
52 | |
53 | use Sub::Quote; |
b1eebd55 |
54 | use Moo; |
6d377074 |
55 | |
56 | has less_than_three => ( |
57 | is => 'rw', |
e57f338d |
58 | isa => quote_sub q{ |
59 | my ($x) = @_; |
60 | die "$x is not less than three" unless $x < 3 |
61 | } |
6d377074 |
62 | ); |
63 | } |
64 | |
65 | run_for 'Bar'; |
66 | |
67 | { |
68 | package Baz; |
69 | |
70 | use Sub::Quote; |
b1eebd55 |
71 | use Moo; |
6d377074 |
72 | |
73 | has less_than_three => ( |
74 | is => 'rw', |
75 | isa => quote_sub( |
e57f338d |
76 | q{ |
77 | my ($value) = @_; |
78 | die "$value is not less than ${word}" unless $value < $limit |
79 | }, |
6d377074 |
80 | { '$limit' => \3, '$word' => \'three' } |
81 | ) |
82 | ); |
83 | } |
84 | |
85 | run_for 'Baz'; |
86 | |
87 | done_testing; |