diff options
author | Rafael Garcia-Suarez <rgs@consttype.org> | 2010-01-10 23:22:35 +0100 |
---|---|---|
committer | Rafael Garcia-Suarez <rgs@consttype.org> | 2010-01-10 23:22:35 +0100 |
commit | a894cef19d191653555ef2267ebed59788db51bf (patch) | |
tree | 5bb63fe2e5a6c830390d40a92081f1005ac3ba59 /lib | |
parent | 18c097a2907a959ca0bf9f988f0c88c0bd9db13a (diff) | |
download | perl-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.pm | 12 | ||||
-rw-r--r-- | lib/Carp.t | 12 |
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 = ''; |