call_sv: check the runtime package to decide whether DB::sub is callable

ext/XS-APItest/t/call.t

@@ -11,7 +11,7 @@ use strict;
 
 BEGIN {
     require '../../t/test.pl';
-    plan(547);
+    plan(548);
     use_ok('XS::APItest')
 };
 use Config;
@@ -395,3 +395,39 @@ fresh_perl_like('use XS::APItest;'
 fresh_perl_like('use XS::APItest;'
               .'XS::APItest::XSUB::test_mismatch_xs_handshake_bad_struct_and_ver("Dog");'
               , qr/\QPerl API version v1.1337.0 of APItest.xs does not match\E/);
+
+{
+    # smartmatch against a subref uses call_sv
+    # the use of this from inside the DB package shouldn't result in
+    # a call to DB::sub
+    # github #24001
+    local $ENV{PERL5DB} = 1;
+    fresh_perl_is(<<'CODE', <<'EXPECT', { switches => [ "-d" ] }, "call_sv from DB");
+print "Before\n";
+DB::doit();
+print "After\n";
+
+sub f {
+  print "In f\n";
+  0;
+}
+
+package DB;
+
+sub doit {
+  0 ~~ \&main::f
+}
+
+sub DB {}
+
+sub sub {
+  print "sub $DB::sub\n";
+  goto &$DB::sub;
+}
+CODE
+Before
+sub DB::doit
+In f
+After
+EXPECT
+}

intrpvar.h

@@ -141,6 +141,8 @@ PERLVAR(I, defgv,	GV *)           /* the *_ glob */
 
 The stash for the package code will be compiled into.
 
+You should use C<CopSTASH(PL_curcop)> to get the current runtime package.
+
 On threaded perls, each thread has an independent copy of this variable;
 each initialized at creation time with the current value of the creating
 thread's copy.

perl.c

@@ -3209,6 +3209,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 arg_flags)
     oldmark = TOPMARK;
 
     if (PERLDB_SUB && PL_curstash != PL_debstash
+          && !CopSTASH_eq(PL_curcop, PL_debstash)
            /* Handle first BEGIN of -d. */
           && (PL_DBcv || (PL_DBcv = GvCV(PL_DBsub)))
            /* Try harder, since this may have been a sighandler, thus

pod/perldelta.pod

@@ -374,7 +374,16 @@ used to be parsed incorrectly.
 
 =item *
 
-XXX
+call_sv() and related functions now check the runtime package instead
+of the package being compiled to when deciding whether the call is
+breakable into C<DB::sub>.
+
+The compile-time package is typically C<main::> when nothing is being
+compiled so C<DB::sub> could be called for sub calls from package DB.
+
+This means that core features that use call_sv(), such as smart match
+against a code reference, no longer incorrectly call C<DB::sub> when
+used from package DB.  Related to [github #24001]
 
 =back