t/demolish-bugs-eats_mini.t

   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;