summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgs@consttype.org>2010-01-10 23:22:35 +0100
committerRafael Garcia-Suarez <rgs@consttype.org>2010-01-10 23:22:35 +0100
commita894cef19d191653555ef2267ebed59788db51bf (patch)
tree5bb63fe2e5a6c830390d40a92081f1005ac3ba59 /lib
parent18c097a2907a959ca0bf9f988f0c88c0bd9db13a (diff)
downloadperl-a894cef19d191653555ef2267ebed59788db51bf.tar.gz
Completely avoid autovivification of CORE::GLOBAL::caller
(by using symbolic references as suggested by Vincent)
Diffstat (limited to 'lib')
-rw-r--r--lib/Carp.pm12
-rw-r--r--lib/Carp.t12
2 files changed, 16 insertions, 8 deletions
diff --git a/lib/Carp.pm b/lib/Carp.pm
index b477ca894c..5b6d555354 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 = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->() : 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 = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->() : caller();
+ local @CARP_NOT = defined &{"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)
- } = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->($i) : caller($i);
+ } = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
unless (defined $call_info{pack}) {
return ();
@@ -150,7 +150,7 @@ sub long_error_loc {
my $lvl = $CarpLevel;
{
++$i;
- my $pkg = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->($i) : caller($i);
+ my $pkg = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
unless(defined($pkg)) {
# This *shouldn't* happen.
if (%Internal) {
@@ -226,9 +226,9 @@ sub short_error_loc {
my $lvl = $CarpLevel;
{
- my $called = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->($i) : caller($i);
+ my $called = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
$i++;
- my $caller = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->($i) : caller($i);
+ my $caller = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
return 0 unless defined($caller); # What happened?
redo if $Internal{$caller};
diff --git a/lib/Carp.t b/lib/Carp.t
index 63b43b21c5..1eee4c4731 100644
--- a/lib/Carp.t
+++ b/lib/Carp.t
@@ -4,6 +4,9 @@ BEGIN {
require './test.pl';
}
+use warnings;
+no warnings "once";
+
my $Is_VMS = $^O eq 'VMS';
use Carp qw(carp cluck croak confess);
@@ -63,7 +66,6 @@ is($info{sub_name}, "eval '$eval'", 'caller_info API');
my $warning;
eval {
BEGIN {
- $^W = 1;
local $SIG{__WARN__} =
sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
}
@@ -270,7 +272,13 @@ cluck_undef (0, "undef", 2, undef, 4);
# has been compiled
{
my $accum = '';
- local *CORE::GLOBAL::caller = sub { local *__ANON__="fakecaller"; my @c=CORE::caller(@_); $c[0] ||= 'undef'; $accum .= "@c[0..3]\n"; return CORE::caller(($_[0]||0)+1) };
+ local *CORE::GLOBAL::caller = sub {
+ local *__ANON__="fakecaller";
+ my @c=CORE::caller(@_);
+ $c[0] ||= 'undef';
+ $accum .= "@c[0..3]\n";
+ return CORE::caller(($_[0]||0)+1);
+ };
eval "scalar caller()";
like( $accum, qr/main::fakecaller/, "test CORE::GLOBAL::caller override in eval");
$accum = '';