ASPN ActiveState Programmer Network
ActiveState
/ Home / Perl / PHP / Python / Tcl / XSLT /
/ Safari / My ASPN /
Cookbooks | Documentation | Mailing Lists | Modules | News Feeds | Products | User Groups


Recent Messages
List Archives
About the List
List Leaders
Subscription Options

View Subscriptions
Help

View by Topic
ActiveState
.NET Framework
Open Source
Perl
PHP
Python
Tcl
Web Services
XML & XSLT

View by Category
Database
General
SOAP
System Administration
Tools
User Interfaces
Web Programming
XML Programming


MyASPN >> Mail Archive >> perl5-porters
perl5-porters
[PATCH] Have Carp respect CORE::GLOBAL::caller if it exists
by David Golden other posts by this author
Nov 4 2009 2:53PM messages near this date
Smoke [5.11.1] v5.11.1-108-gd83f38d FAIL(F) openbsd 4.6 (i386/1 cpu) | Smoke [5.11.1] v5.11.1-108-gd83f38d FAIL(F) openvms V8.3-1H1 (IA64/2 cpu)
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.
---
 lib/Carp.pm |   15 +++++++++------
 1 files changed, 9 insertions(+), 6 deletions(-)

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};
-- 
1.6.0.4

Privacy Policy | Email Opt-out | Feedback | Syndication
© ActiveState Software Inc. All rights reserved