From: Perl 5 Porters Date: Thu, 25 Jul 1996 02:24:34 +0000 (+0000) Subject: perl 5.003_01: lib/Carp.pm X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c7d862108a3f02f3db65204f8154cdfe689040e;p=p5sagit%2Fp5-mst-13.2.git perl 5.003_01: lib/Carp.pm Eliminate $& to avoid runtime penalty Consider @ISA when tracing call stack --- diff --git a/lib/Carp.pm b/lib/Carp.pm index f30bd24..5de8f83 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -47,7 +47,7 @@ sub longmess { if ($require) { $sub = "require $eval"; } else { - $eval =~ s/[\\\']/\\$&/g; + $eval =~ s/([\\\'])/\\$1/g; if ($MaxEvalLen && length($eval) > $MaxEvalLen) { substr($eval,$MaxEvalLen) = '...'; } @@ -66,20 +66,40 @@ sub longmess { sub shortmess { # Short-circuit &longmess if called via multiple packages my $error = $_[0]; # Instead of "shift" - my ($curpack) = caller(1); + my ($prevpack) = caller(1); my $extra = $CarpLevel; my $i = 2; my ($pack,$file,$line); + my %isa = ($prevpack,1); + + @isa{@{"${prevpack}::ISA"}} = () + if(defined @{"${prevpack}::ISA"}); + while (($pack,$file,$line) = caller($i++)) { - if ($pack ne $curpack) { - if ($extra-- > 0) { - $curpack = $pack; - } - else { - return "$error at $file line $line\n"; - } + if(defined @{$pack . "::ISA"}) { + my @i = @{$pack . "::ISA"}; + my %i; + @i{@i} = (); + @isa{@i,$pack} = () + if(exists $i{$prevpack} || exists $isa{$pack}); + } + + next + if(exists $isa{$pack}); + + if ($extra-- > 0) { + %isa = ($pack,1); + @isa{@{$pack . "::ISA"}} = () + if(defined @{$pack . "::ISA"}); + } + else { + return "$error at $file line $line\n"; } } + continue { + $prevpack = $pack; + } + goto &longmess; }