[perl #93324] Don’t autovivify *B:: in Carp

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.

2 files changed, 20 insertions, 3 deletions

diff --git a/lib/Carp.pm b/lib/Carp.pm
index 77fc2a1e2c..6148a6862f 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 b9997cc4e7..35272e51f9 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"