diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t index e31c2db4d7cd..955fee4411c2 100644 --- a/ext/XS-APItest/t/call.t +++ b/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 +} diff --git a/intrpvar.h b/intrpvar.h index 84664f9f7038..f6f317453e66 100644 --- a/intrpvar.h +++ b/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 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. diff --git a/perl.c b/perl.c index 1881ffc51739..91cd4c97c8ee 100644 --- a/perl.c +++ b/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 diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 412acc5b0134..a8a62b8edcce 100644 --- a/pod/perldelta.pod +++ b/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. + +The compile-time package is typically C when nothing is being +compiled so C 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 when +used from package DB. Related to [github #24001] =back