dagolden at cpan
Nov 4, 2009, 2:53 PM
Post #1 of 1
(57 views)
Permalink
|
|
[PATCH] 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.
---
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
|
