From 1a6d530815db93f4d29b8908b300986ab9eefd59 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 13 Jul 2011 22:35:13 -0700
Subject: [PATCH] =?utf8?q?[perl=20#93324]=20Don=E2=80=99t=20autovivify=20*?=
 =?utf8?q?B::=20in=20Carp?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

While this may be bending over backwards, this avoids causing problems
for the Perl compiler suite and also for various CPAN modules that use
A, B and C packages for testing.
---
 lib/Carp.pm |  9 +++++++--
 lib/Carp.t  | 14 +++++++++++++-
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/lib/Carp.pm b/lib/Carp.pm
index 77fc2a1..6148a68 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -3,7 +3,7 @@ package Carp;
 use strict;
 use warnings;
 
-our $VERSION = '1.20';
+our $VERSION = '1.21';
 
 our $MaxEvalLen = 0;
 our $Verbose    = 0;
@@ -107,7 +107,12 @@ sub caller_info {
             local $@;
             my $where = eval {
                 my $func    = $cgc or return '';
-                my $gv      = B::svref_2object($func)->GV;
+                my $gv      =
+                    *{
+                        ( $::{"B::"} || return '')       # B stash
+                          ->{svref_2object} || return '' # entry in stash
+                     }{CODE}                             # coderef in entry
+                        ->($func)->GV;
                 my $package = $gv->STASH->NAME;
                 my $subname = $gv->NAME;
                 return unless defined $package && defined $subname;
diff --git a/lib/Carp.t b/lib/Carp.t
index b9997cc..35272e5 100644
--- a/lib/Carp.t
+++ b/lib/Carp.t
@@ -12,7 +12,7 @@ my $Is_VMS = $^O eq 'VMS';
 use Carp qw(carp cluck croak confess);
 
 BEGIN {
-    plan tests => 57;
+    plan tests => 58;
 
     # This test must be run at BEGIN time, because code later in this file
     # sets CORE::GLOBAL::caller
@@ -390,6 +390,18 @@ fresh_perl_like(
  'Carp can handle UTF8-flagged strings after a syntax error',
 );
 
+fresh_perl_is(
+ q<
+   use Carp;
+   $SIG{__WARN__} = sub{};
+   carp ("A duck, but which duck?");
+   print "ok" unless exists $::{"B::"};
+  >,
+ 'ok',
+ {},
+ 'Carp does not autovivify *B::'
+);
+
 # New tests go here
 
 # line 1 "A"
-- 
2.7.4