git.maemo.org Git - pkg-perl/blob - deb-src/libtest-exception-perl/libtest-exception-perl-0.27/t/edge-cases.t

   1 #! /usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More skip_all => 'stuff relating to RT#24678 that I have not fixed yet';
   6
   7 use Test::Exception tests => 12;
   8
   9 sub A1::DESTROY {eval{}}
  10 dies_ok { my $x = bless [], 'A1'; die } q[Unlocalized $@ for eval{} during DESTROY];
  11
  12 sub A2::DESTROY {die 43 }
  13 throws_ok { my $x = bless [], 'A2'; die 42} qr/42.+43/s, q[Died with the primary and secondar errors];
  14
  15 sub A2a::DESTROY { die 42 }
  16 throws_ok { my $obj = bless [], 'A2a'; die 43 } qr/43/,
  17     q[Of multiple failures, the "primary" one is returned];
  18
  19 {
  20     sub A3::DESTROY {die}
  21     dies_ok { my $x = bless [], 'A3'; 1 } q[Death during destruction for success is noticed];
  22 }
  23
  24
  25 sub A4::DESTROY {delete$SIG{__DIE__};eval{}}
  26 dies_ok { my $x = bless [], 'A4'; die } q[Unlocalized $@ for eval{} during DESTROY];
  27
  28 sub A5::DESTROY {delete$SIG{__DIE__};die 43 }
  29 throws_ok { my $x = bless [], 'A5'; die 42} qr/42.+43/s, q[Died with the primary and secondar errors];
  30
  31 TODO: {
  32     our $TODO = q[No clue how to solve this one.];
  33     sub A6::DESTROY {delete$SIG{__DIE__};die}
  34     dies_ok { my $x = bless [], 'A6'; 1 } q[Death during destruction for success is noticed];
  35 }
  36
  37
  38 dies_ok { die bless [], 0 } q[Died with a "false" exception class];
  39 dies_ok { die bless [], "\0" } q[Died with a "false" exception class];
  40
  41 package A7;
  42 use overload bool => sub { 0 }, '0+' => sub { 0 }, '""' => sub { '' }, fallback => 1;
  43 package main;
  44 dies_ok { die bless [], 'A7' } q[False overloaded exceptions are noticed];
  45
  46
  47 $main::{'0::'} = $main::{'A7::'};
  48 dies_ok { die bless [], 0 } q[Died a false death];
  49
  50
  51 package A8;
  52 use overload bool => sub {eval{};0}, '0+' => sub{eval{};0}, '""' => sub { eval{}; '' }, fallback => 1;
  53 package main;
  54 dies_ok { die bless [], 'A8' } q[Evanescent exceptions are noticed];
  55
  56
  57 __END__
  58
  59  dies_ok{ my $foo = Foo->new; die "Fatal Error" };
  60  lives_ok{ my $foo = Foo->new; die "Fatal Error" };
  61
  62  not ok 1
  63  # Code died, but appeared to live because $@ was reset
  64  # unexpectedly by a DESTROY method called during cleanup
  65  not ok 2
  66  # Code died, but appeared to live because $@ was reset
  67  # unexpectedly by a DESTROY method called during cleanup