Fix pp_goto crash with orphaned GV

a7999c089 inadvertently made pp_goto crash if the GV had no
stash pointer.

diff --git a/t/run/switchd.t b/t/run/switchd.t
index 9246b35..eadcd94 100644 (file)
--- a/t/run/switchd.t
+++ b/t/run/switchd.t
@@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; }
 
 # This test depends on t/lib/Devel/switchd*.pm.
 
-plan(tests => 6);
+plan(tests => 7);
 
 my $r;
 
@@ -94,3 +94,19 @@ like(
   qr "1\r?\n2\r?\n",
  'Subroutines no longer found under their names can be called',
 );
+
+# [rt.cpan.org #69862]
+like(
+  runperl(
+   switches => [ '-Ilib', '-d:switchd_empty' ],
+   progs    => [
+    'sub DB::sub { goto &$DB::sub }',
+    'sub foo { goto &bar::baz; }',
+    'sub bar::baz { print qq _ok\n_ }',
+    'delete $::{bar::::};',
+    'foo();',
+   ],
+  ),
+  qr "ok\r?\n",
+ 'No crash when calling orphaned subroutine via goto &',
+);

diff --git a/util.c b/util.c
index aa2ae55..8b2e5f5 100644 (file)
--- a/util.c
+++ b/util.c
@@ -6555,7 +6555,10 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
     if (!PERLDB_SUB_NN) {
        GV *gv = CvGV(cv);
 
-       if ( svp && ((CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+       if (!svp) {
+           gv_efullname3(dbsv, gv, NULL);
+       }
+       else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
             || strEQ(GvNAME(gv), "END")
             || ( /* Could be imported, and old sub redefined. */
                 (GvCV(gv) != cv || !S_gv_has_usable_name(aTHX_ gv))
@@ -6566,7 +6569,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
                    && S_gv_has_usable_name(aTHX_ gv = (GV *)*svp) 
                  )
                )
-       )) {
+       ) {
            /* GV is potentially non-unique, or contain different CV. */
            SV * const tmp = newRV(MUTABLE_SV(cv));
            sv_setsv(dbsv, tmp);