From: David Golden <dagolden@cpan.org>
Date: Wed, 4 Nov 2009 22:33:11 +0000 (-0500)
Subject: Have Carp respect CORE::GLOBAL::caller if it exists
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=45a2d9782bd1c90e53c52dacd30d9b185db62239;p=p5sagit%2Fp5-mst-13.2.git

Have Carp respect CORE::GLOBAL::caller if it exists

Carp frequently gets loaded very early, before tools that want to
override caller().  Previously, caller() was only in Carp::Heavy,
which was only loaded on demand (thus after any CORE::GLOBAL::caller
override).  This patch unbreaks anything expecting the old behavior.
---

diff --git a/lib/Carp.pm b/lib/Carp.pm
index 69d5c1f..0826016 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -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 = exists $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 = exists $CORE::GLOBAL::{caller} ? $CORE::GLOBAL::{caller}->() : caller();
     shortmess_heavy(@_);
 };
 
@@ -70,7 +70,7 @@ sub caller_info {
   my %call_info;
   @call_info{
     qw(pack file line sub has_args wantarray evaltext is_require)
-  } = caller($i);
+  } = exists $CORE::GLOBAL::{caller} ? $CORE::GLOBAL::{caller}->($i) : caller($i);
   
   unless (defined $call_info{pack}) {
     return ();
@@ -149,7 +149,8 @@ sub long_error_loc {
   my $i;
   my $lvl = $CarpLevel;
   {
-    my $pkg = caller(++$i);
+    ++$i;
+    my $pkg = exists $CORE::GLOBAL::{caller} ? $CORE::GLOBAL::{caller}->($i) : caller($i);
     unless(defined($pkg)) {
       # This *shouldn't* happen.
       if (%Internal) {
@@ -224,8 +225,10 @@ sub short_error_loc {
   my $i = 1;
   my $lvl = $CarpLevel;
   {
-    my $called = caller($i++);
-    my $caller = caller($i);
+
+    my $called = exists $CORE::GLOBAL::{caller} ? $CORE::GLOBAL::{caller}->($i) : caller($i);
+    $i++;
+    my $caller = exists $CORE::GLOBAL::{caller} ? $CORE::GLOBAL::{caller}->($i) : caller($i);
 
     return 0 unless defined($caller); # What happened?
     redo if $Internal{$caller};