diff options
-rwxr-xr-x | lib/diagnostics.pm | 13 | ||||
-rw-r--r-- | lib/diagnostics.t | 34 |
2 files changed, 17 insertions, 30 deletions
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index 4ef9a2f64d..b2249430b2 100755 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -476,11 +476,18 @@ sub death_trap { if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap; + return if $in_eval; + # We don't want to unset these if we're coming from an eval because - # then we've turned off diagnostics. (Actually what does this next - # line do? -PSeibel) - $SIG{__DIE__} = $SIG{__WARN__} = '' unless $in_eval; + # then we've turned off diagnostics. + + # Switch off our die/warn handlers so we don't wind up in our own + # traps. + $SIG{__DIE__} = $SIG{__WARN__} = ''; + + # Have carp skip over death_trap() when showing the stack trace. local($Carp::CarpLevel) = 1; + confess "Uncaught exception from user code:\n\t$exception"; # up we go; where we stop, nobody knows, but i think we die now # but i'm deeply afraid of the &$olddie guy reraising and us getting diff --git a/lib/diagnostics.t b/lib/diagnostics.t index 14014f6b68..486f8f6dd8 100644 --- a/lib/diagnostics.t +++ b/lib/diagnostics.t @@ -5,34 +5,14 @@ BEGIN { @INC = 'lib'; } +use Test::More tests => 2; -######################### We start with some black magic to print on failure. +BEGIN { use_ok('diagnostics') } -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) -use strict; -use warnings; +require base; -use vars qw($Test_Num $Total_tests); +eval { + 'base'->import(qw(I::do::not::exist)); +}; -my $loaded; -BEGIN { $| = 1; $Test_Num = 1 } -END {print "not ok $Test_Num\n" unless $loaded;} -print "1..$Total_tests\n"; -BEGIN { require diagnostics; } # Don't want diagnostics' noise yet. -$loaded = 1; -ok($loaded, 'compile'); -######################### End of black magic. - -sub ok { - my($test, $name) = shift; - print "not " unless $test; - print "ok $Test_Num"; - print " - $name" if defined $name; - print "\n"; - $Test_Num++; -} - - -# Change this to your # of ok() calls + 1 -BEGIN { $Total_tests = 1 } +is( $@, '', 'diagnostics not tripped up by "use base qw(Dont::Exist)"' ); |