t/100_bugs/012_DEMOLISH_eats_mini.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 4;
   7 use Test::Exception;
   8
   9
  10
  11 {
  12     package Foo;
  13     use Moose;
  14
  15     has 'bar' => (
  16         is       => 'ro',
  17         required => 1,
  18     );
  19
  20     # Defining this causes the FIRST call to Baz->new w/o param to fail,
  21     # if no call to ANY Moose::Object->new was done before.
  22     sub DEMOLISH {
  23         my ( $self ) = @_;
  24         # ... Moose (kinda) eats exceptions in DESTROY/DEMOLISH";
  25     }
  26 }
  27
  28 {
  29     my $obj = eval { Foo->new; };
  30     ::like( $@, qr/is required/, "... Foo plain" );
  31     ::is( $obj, undef, "... the object is undef" );
  32 }
  33
  34 {
  35     package Bar;
  36
  37     sub new { die "Bar died"; }
  38
  39     sub DESTROY {
  40         die "Vanilla Perl eats exceptions in DESTROY too";
  41     }
  42 }
  43
  44 {
  45     my $obj = eval { Bar->new; };
  46     ::like( $@, qr/Bar died/, "... Bar plain" );
  47     ::is( $obj, undef, "... the object is undef" );
  48 }
  49
  50 1;
  51