Make sure $DB::sub is callable

When DB::sub is about to be called (to handle a subroutine call under
the debugger), $DB::sub is set to the name of the subroutine or a ref-
erence to it.

Sometimes $DB::sub is set to the name when the subroutine is not call-
able under that name.  That should not happen.

This logic in util.c:Perl_get_db_sub decides whether a reference
should be used:

	if ( svp && ((CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
	     || strEQ(GvNAME(gv), "END")
	     || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
		 !( (SvTYPE(*svp) == SVt_PVGV)
		    && (GvCV((const GV *)*svp) == cv)
		    && (gv = (GV *)*svp)
		  )
		)
	)) {
	    /* Use GV from the stack as a fallback. */

(That comment about using the GV from the stack as a fallback applies
to the assignment to gv, but was mistakenly divorced from it in commit
3de9ffa12.)

This logic (introduced in 71be2cbc7 [inseparable changes from
perl5.003_13 to perl5.003_14] and integrated into blead in 491527d02)
tries to find a GV that points to the CV, trying the CV’s own GV
first, and falling back to what is on the stack.  But it does not
account for GVs that are not found under their names, which can hap-
pen when a glob is copied and the original is undefined ($foo = *bar;
undef *bar; &$foo) or when a stash element or package is deleted, such
as via Symbol::delete_package.

If the subroutine is not locatable under its own name or the name
under which it was called (the name of the GV argument to entersub),
then a reference should be passed.  Otherwise a name that can access
the sub should be passed.

So this commit adds more (no, not more!) conditions to make sure the
gv is actually reachable under its name before using a string.

Since, for effiency, those conditions do not perform an actual symbol
lookup, but simply look inside the GV’s stash, we can no longer rely
on gv_efullname (or even gv_fullname), as the stash may have been
moved around, but use HvENAME and construct the GV name ourselves.

1 files changed, 17 insertions, 1 deletions

diff --git a/t/run/switchd.t b/t/run/switchd.t
index 3ea468156d..9246b35229 100644
--- 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 => 5);
+plan(tests => 6);
 
 my $r;
 
@@ -78,3 +78,19 @@ like(
   qr "1\r?\n2\r?\n",
  'Subroutine redefinition works in the debugger [perl #48332]',
 );
+
+# [rt.cpan.org #69862]
+like(
+  runperl(
+   switches => [ '-Ilib', '-d:switchd_empty' ],
+   progs    => [
+    'sub DB::sub { goto &$DB::sub }',
+    'sub foo { print qq _1\n_ }',
+    'sub bar { print qq _2\n_ }',
+    'delete $::{foo}; eval { foo() };',
+    'my $bar = *bar; undef *bar; eval { &$bar };',
+   ],
+  ),
+  qr "1\r?\n2\r?\n",
+ 'Subroutines no longer found under their names can be called',
+);