keep the same return value init_meta had previously
[gitmo/Moose.git] / t / bugs / DEMOLISH_eats_mini.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7 use Test::Fatal;
8
9
10 {
11     package Foo;
12     use Moose;
13
14     has 'bar' => (
15         is       => 'ro',
16         required => 1,
17     );
18
19     # Defining this causes the FIRST call to Baz->new w/o param to fail,
20     # if no call to ANY Moose::Object->new was done before.
21     sub DEMOLISH {
22         my ( $self ) = @_;
23         # ... Moose (kinda) eats exceptions in DESTROY/DEMOLISH";
24     }
25 }
26
27 {
28     my $obj = eval { Foo->new; };
29     like( $@, qr/is required/, "... Foo plain" );
30     is( $obj, undef, "... the object is undef" );
31 }
32
33 {
34     package Bar;
35
36     sub new { die "Bar died"; }
37
38     sub DESTROY {
39         die "Vanilla Perl eats exceptions in DESTROY too";
40     }
41 }
42
43 {
44     my $obj = eval { Bar->new; };
45     like( $@, qr/Bar died/, "... Bar plain" );
46     is( $obj, undef, "... the object is undef" );
47 }
48
49 {
50     package Baz;
51     use Moose;
52
53     sub DEMOLISH {
54         $? = 0;
55     }
56 }
57
58 {
59     local $@ = 42;
60     local $? = 84;
61
62     {
63         Baz->new;
64     }
65
66     is( $@, 42, '$@ is still 42 after object is demolished without dying' );
67     is( $?, 84, '$? is still 84 after object is demolished without dying' );
68
69     local $@ = 0;
70
71     {
72         Baz->new;
73     }
74
75     is( $@, 0, '$@ is still 0 after object is demolished without dying' );
76
77     Baz->meta->make_immutable, redo
78         if Baz->meta->is_mutable
79 }
80
81 done_testing;