summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xlib/diagnostics.pm13
-rw-r--r--lib/diagnostics.t34
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)"' );