Perl 5.001perl-5.001

[See the Changes file for a list of changes]

1 files changed, 16 insertions, 5 deletions

diff --git a/lib/Carp.pm b/lib/Carp.pm
index 5daba5c289..c847b77b36 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -3,6 +3,8 @@ package Carp;
 # This package implements handy routines for modules that wish to throw
 # exceptions outside of the current package.
 
+$CarpLevel = 0;		# How many extra package levels to skip on carp.
+
 require Exporter;
 @ISA = Exporter;
 @EXPORT = qw(confess croak carp);
@@ -10,7 +12,7 @@ require Exporter;
 sub longmess {
     my $error = shift;
     my $mess = "";
-    my $i = 2;
+    my $i = 1 + $CarpLevel;
     my ($pack,$file,$line,$sub);
     while (($pack,$file,$line,$sub) = caller($i++)) {
 	$mess .= "\t$sub " if $error eq "called";
@@ -20,18 +22,27 @@ sub longmess {
     $mess || $error;
 }
 
-sub shortmess {
-    my $error = shift;
+sub shortmess {	# Short-circuit &longmess if called via multiple packages
+    my $error = $_[0];	# Instead of "shift"
     my ($curpack) = caller(1);
+    my $extra = $CarpLevel;
     my $i = 2;
     my ($pack,$file,$line,$sub);
     while (($pack,$file,$line,$sub) = caller($i++)) {
-	return "$error at $file line $line\n" if $pack ne $curpack;
+	if ($pack ne $curpack) {
+	    if ($extra-- > 0) {
+		$curpack = $pack;
+	    }
+	    else {
+		return "$error at $file line $line\n";
+	    }
+	}
     }
-    longmess $error;
+    goto &longmess;
 }
 
 sub confess { die longmess @_; }
 sub croak { die shortmess @_; }
 sub carp { warn shortmess @_; }
 
+1;