Recommend a more reliable way of identifying magic

[perl5.git] / lib / Carp.pm

diff --git a/lib/Carp.pm b/lib/Carp.pm
index 0c69860..4b3f4f6 100644 (file)
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -1,6 +1,6 @@
 package Carp;
 
-our $VERSION = '1.12';
+our $VERSION = '1.19';
 
 our $MaxEvalLen = 0;
 our $Verbose    = 0;
@@ -43,7 +43,7 @@ sub longmess {
     # 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();
+    my $call_pack = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}() : caller();
     if ($Internal{$call_pack} or $CarpInternal{$call_pack}) {
       return longmess_heavy(@_);
     }
@@ -55,7 +55,7 @@ sub longmess {
 
 sub shortmess {
     # Icky backwards compatibility wrapper. :-(
-    local @CARP_NOT = caller();
+    local @CARP_NOT = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}() : caller();
     shortmess_heavy(@_);
 };
 
@@ -66,11 +66,14 @@ sub cluck   { warn longmess  @_ }
 
 sub caller_info {
   my $i = shift(@_) + 1;
-  package DB;
   my %call_info;
+  {
+  package DB;
+  @args = \$i; # A sentinal, which no-one else has the address of
   @call_info{
     qw(pack file line sub has_args wantarray evaltext is_require)
-  } = caller($i);
+  } = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
+  }
   
   unless (defined $call_info{pack}) {
     return ();
@@ -78,7 +81,24 @@ sub caller_info {
 
   my $sub_name = Carp::get_subname(\%call_info);
   if ($call_info{has_args}) {
-    my @args = map {Carp::format_arg($_)} @DB::args;
+    my @args;
+    if (@DB::args == 1 && ref $DB::args[0] eq ref \$i && $DB::args[0] == \$i) {
+      @DB::args = (); # Don't let anyone see the address of $i
+      local $@;
+      my $where = eval {
+       my $func = defined &{"CORE::GLOBAL::caller"} ? \&{"CORE::GLOBAL::caller"} : return '';
+       my $gv = B::svref_2object($func)->GV;
+       my $package = $gv->STASH->NAME;
+       my $subname = $gv->NAME;
+       return unless defined $package && defined $subname;
+       # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
+       return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
+       " in &${package}::$subname";
+      } // '';
+      @args = "** Incomplete caller override detected$where; \@DB::args were not set **";
+    } else {
+      @args = map {Carp::format_arg($_)} @DB::args;
+    }
     if ($MaxArgNums and @args > $MaxArgNums) { # More than we want to show?
       $#args = $MaxArgNums;
       push @args, '...';
@@ -149,7 +169,8 @@ sub long_error_loc {
   my $i;
   my $lvl = $CarpLevel;
   {
-    my $pkg = caller(++$i);
+    ++$i;
+    my $pkg = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
     unless(defined($pkg)) {
       # This *shouldn't* happen.
       if (%Internal) {
@@ -224,8 +245,10 @@ sub short_error_loc {
   my $i = 1;
   my $lvl = $CarpLevel;
   {
-    my $called = caller($i++);
-    my $caller = caller($i);
+
+    my $called = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
+    $i++;
+    my $caller = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
 
     return 0 unless defined($caller); # What happened?
     redo if $Internal{$caller};
@@ -425,7 +448,7 @@ Defaults to C<8>.
 
 =head2 $Carp::Verbose
 
-This variable makes C<carp> and C<cluck> generate stack backtraces
+This variable makes C<carp> and C<croak> generate stack backtraces
 just like C<cluck> and C<confess>.  This is how C<use Carp 'verbose'>
 is implemented internally.
 
@@ -463,7 +486,7 @@ Example of use:
 This would make C<Carp> report the error as coming from a caller not
 in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
 
-Also read the L</"Description"> section above, about how C<Carp> decides
+Also read the L</DESCRIPTION> section above, about how C<Carp> decides
 where the error is reported from.
 
 Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.