From: Rafael Garcia-Suarez <rgs@consttype.org>
Date: Sun, 10 Jan 2010 22:22:35 +0000 (+0100)
Subject: Completely avoid autovivification of CORE::GLOBAL::caller
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a894cef19d191653555ef2267ebed59788db51bf;p=p5sagit%2Fp5-mst-13.2.git

Completely avoid autovivification of CORE::GLOBAL::caller

(by using symbolic references as suggested by Vincent)
---

diff --git a/lib/Carp.pm b/lib/Carp.pm
index b477ca8..5b6d555 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 63b43b2..1eee4c4 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 = '';