perl5db on miniperl

[p5sagit/p5-mst-13.2.git] / lib / Carp / Heavy.pm

diff --git a/lib/Carp/Heavy.pm b/lib/Carp/Heavy.pm
index 79aa5f8..a293b59 100644 (file)
--- a/lib/Carp/Heavy.pm
+++ b/lib/Carp/Heavy.pm
@@ -15,10 +15,6 @@ use Carp;  our $VERSION = $Carp::VERSION;
 # these are called, they require Carp::Heavy which installs the real
 # routines.
 
-# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
-# _almost_ complete understanding of the package.  Corrections and
-# comments are welcome.
-
 # The members of %Internal are packages that are internal to perl.
 # Carp will not report errors from within these packages if it
 # can.  The members of %CarpInternal are internal to Perl's warning
@@ -28,12 +24,6 @@ use Carp;  our $VERSION = $Carp::VERSION;
 # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
 # text and function arguments should be formatted when printed.
 
-# Comments added by Jos I. Boumans <kane@dwim.org> 11-Aug-2004
-# I can not get %CarpInternal or %Internal to work as advertised,
-# therefore leaving it out of the below documentation.
-# $CarpLevel may be decprecated according to the last comment, but
-# after 6 years, it's still around and in heavy use ;)
-
 # disable these by default, so they can live w/o require Carp
 $CarpInternal{Carp}++;
 $CarpInternal{warnings}++;
@@ -48,6 +38,11 @@ our ($CarpLevel, $MaxArgNums, $MaxEvalLen, $MaxArgLen, $Verbose);
 
 sub  longmess_real {
     # Icky backwards compatibility wrapper. :-(
+    #
+    # The story is that the original implementation hard-coded the
+    # number of call levels to go back, so calls to longmess were off
+    # by one.  Other code began calling longmess and expecting this
+    # behaviour, so the replacement has to emulate that behaviour.
     my $call_pack = caller();
     if ($Internal{$call_pack} or $CarpInternal{$call_pack}) {
       return longmess_heavy(@_);
@@ -60,7 +55,6 @@ sub  longmess_real {
 
 sub shortmess_real {
     # Icky backwards compatibility wrapper. :-(
-    my $call_pack = caller();
     local @CARP_NOT = caller();
     shortmess_heavy(@_);
 };
@@ -69,7 +63,12 @@ sub shortmess_real {
 
 # aliasing the whole glob rather than just the CV slot avoids 'redefined'
 # warnings, even in the presence of perl -W (as used by lib/warnings.t !)
+# However it has the potential to create infinite loops, if somehow Carp
+# is forcibly reloaded, but $INC{"Carp/Heavy.pm"} remains true.
+# Hence the extra hack of deleting the previous typeglob first.
 
+delete $Carp::{shortmess_jmp};
+delete $Carp::{longmess_jmp};
 *longmess_jmp  = *longmess_real;
 *shortmess_jmp = *shortmess_real;
 
@@ -103,11 +102,10 @@ sub caller_info {
 # Transform an argument to a function into a string.
 sub format_arg {
   my $arg = shift;
-  if (not defined($arg)) {
-    $arg = 'undef';
-  }
-  elsif (ref($arg)) {
+  if (ref($arg)) {
       $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
+  }elsif (not defined($arg)) {
+    $arg = 'undef';
   }
   $arg =~ s/'/\\'/g;
   $arg = str_len_trim($arg, $MaxArgLen);
@@ -226,7 +224,10 @@ sub ret_summary {
 
 
 sub short_error_loc {
-  my $cache;
+  # You have to create your (hash)ref out here, rather than defaulting it
+  # inside trusts *on a lexical*, as you want it to persist across calls.
+  # (You can default it on $_[2], but that gets messy)
+  my $cache = {};
   my $i = 1;
   my $lvl = $CarpLevel;
   {
@@ -235,6 +236,7 @@ sub short_error_loc {
 
     return 0 unless defined($caller); # What happened?
     redo if $Internal{$caller};
+    redo if $CarpInternal{$caller};
     redo if $CarpInternal{$called};
     redo if trusts($called, $caller, $cache);
     redo if trusts($caller, $called, $cache);
@@ -275,7 +277,7 @@ sub str_len_trim {
 sub trusts {
     my $child = shift;
     my $parent = shift;
-    my $cache = shift || {};
+    my $cache = shift;
     my ($known, $partial) = get_status($cache, $child);
     # Figure out consequences until we have an answer
     while (@$partial and not exists $known->{$parent}) {