Commit | Line | Data |
c2cc003f |
1 | |
2 | use strictures 1; |
3 | use Test::More; |
4 | use Test::Fatal; |
5 | |
6 | { |
7 | package Foo; |
8 | use Moo; |
9 | |
10 | has 'bar' => ( |
11 | is => 'ro', |
12 | required => 1, |
13 | ); |
14 | |
15 | # Defining this causes the FIRST call to Baz->new w/o param to fail, |
16 | # if no call to ANY Moo::Object->new was done before. |
17 | sub DEMOLISH { |
18 | my ( $self ) = @_; |
19 | # ... Moo (kinda) eats exceptions in DESTROY/DEMOLISH"; |
20 | } |
21 | } |
22 | |
23 | { |
24 | my $obj = eval { Foo->new; }; |
25 | like( $@, qr/Missing required arguments/, "... Foo plain" ); |
26 | is( $obj, undef, "... the object is undef" ); |
27 | } |
28 | |
29 | { |
30 | package Bar; |
31 | |
32 | sub new { die "Bar died"; } |
33 | |
34 | sub DESTROY { |
35 | die "Vanilla Perl eats exceptions in DESTROY too"; |
36 | } |
37 | } |
38 | |
39 | { |
40 | my $obj = eval { Bar->new; }; |
41 | like( $@, qr/Bar died/, "... Bar plain" ); |
42 | is( $obj, undef, "... the object is undef" ); |
43 | } |
44 | |
45 | { |
46 | package Baz; |
47 | use Moo; |
48 | |
49 | sub DEMOLISH { |
50 | $? = 0; |
51 | } |
52 | } |
53 | |
54 | { |
55 | local $@ = 42; |
56 | local $? = 84; |
57 | |
58 | { |
59 | Baz->new; |
60 | } |
61 | |
62 | is( $@, 42, '$@ is still 42 after object is demolished without dying' ); |
63 | is( $?, 84, '$? is still 84 after object is demolished without dying' ); |
64 | |
65 | local $@ = 0; |
66 | |
67 | { |
68 | Baz->new; |
69 | } |
70 | |
71 | is( $@, 0, '$@ is still 0 after object is demolished without dying' ); |
72 | |
73 | } |
74 | |
75 | done_testing; |