--- lib/Test/Exception.pm.~1~ 2006-10-07 01:42:36.000000000 -0700
+++ lib/Test/Exception.pm 2007-01-30 23:32:07.000000000 -0800
@@ -5,6 +5,7 @@
use Test::Builder;
use Sub::Uplevel qw( uplevel );
use base qw( Exporter );
+use Scalar::Util 'blessed';
use Carp;
our $VERSION = '0.24';
@@ -77,12 +78,28 @@
=cut
-
+our $DIED;
+sub DIED {
+
+ $DIED = 1;
+}
sub _try_as_caller {
my $coderef = shift;
- eval { uplevel 3, $coderef };
- return $@;
+ local $@;
+ local $SIG{__DIE__} = $SIG{__DIE__};
+ $DIED = 0;
+
+ my $failed = not defined eval {
+ $SIG{__DIE__} = \ &DIED;
+ uplevel 3, $coderef;
+ };
+
+ return defined( blessed( $@ ) ) ? $@ :
+ $@ ? $@ :
+ $DIED ? "Died\n" :
+ $failed ? "Died\n" :
+ '';
};
--- /dev/null 2006-10-26 22:58:30.000000000 -0700
+++ t/pathological.t 2007-01-30 23:46:21.000000000 -0800
@@ -0,0 +1,47 @@
+use strict;
+use warnings;
+use Test::More tests => 11;
+use Test::Exception;
+
+sub A1::DESTROY {eval{}}
+dies_ok { my $x = bless [], 'A1'; die } q[Unlocalized $@ for eval{} during DESTROY];
+
+sub A2::DESTROY {die 43 }
+throws_ok { my $x = bless [], 'A2'; die 42} qr/42.+43/s, q[Died with the primary and secondar errors];
+
+{
+ sub A3::DESTROY {die}
+ dies_ok { my $x = bless [], 'A3'; 1 } q[Death during destruction for success is noticed];
+}
+
+
+sub A4::DESTROY {delete$SIG{__DIE__};eval{}}
+dies_ok { my $x = bless [], 'A4'; die } q[Unlocalized $@ for eval{} during DESTROY];
+
+sub A5::DESTROY {delete$SIG{__DIE__};die 43 }
+throws_ok { my $x = bless [], 'A5'; die 42} qr/42.+43/s, q[Died with the primary and secondar errors];
+
+TODO: {
+ local $TODO = q[No clue how to solve this one.];
+ sub A6::DESTROY {delete$SIG{__DIE__};die}
+ dies_ok { my $x = bless [], 'A6'; 1 } q[Death during destruction for success is noticed];
+}
+
+
+dies_ok { die bless [], 0 } q[Died with a "false" exception class];
+dies_ok { die bless [], "\0" } q[Died with a "false" exception class];
+
+package A7;
+use overload bool => sub { 0 }, '0+' => sub { 0 }, '""' => sub { '' }, fallback => 1;
+package main;
+dies_ok { die bless [], 'A7' } q[False overloaded exceptions are noticed];
+
+
+$main::{'0::'} = $main::{'A7::'};
+dies_ok { die bless [], 0 } q[Died a false death];
+
+
+package A8;
+use overload bool => sub {eval{};0}, '0+' => sub{eval{};0}, '""' => sub { eval{}; '' }, fallback => 1;
+package main;
+dies_ok { die bless [], 'A8' } q[Evanescent exceptions are noticed];
