mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

pad.c: Fix GH Issue #19463, -DXv fails assert when dumping anonymous constant sub

Browse Source 
Anonymous constant subs were changed to be implemented internally as
XSUBs in 5.21.6, commit 1567c65ac069266bfe65959430c185babd476538.
This broke DEBUGGING perls running under -DXv which weren't taught
about the new implementation. In ed958fa3156084f3cf4d8c4768716d9e1a11ce91
strict.pm also was changed to use such subs, which then breaks many
uses of -DXv.

See t/run/switchDx.t for an example of code that would trigger this that
does not depend on strict.pm

This fixes the problem and adds a test for -Dx.
This commit is contained in:
Yves Orton 2022-02-27 03:20:42 +01:00 committed by Karl Williamson
parent ba2557cc22
commit 277d63d68e
2 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pad.c
View File

@ -1858,7 +1858,6 @@ STATIC void
S_cv_dump(pTHX_ const CV *cv, const char *title)
{
const CV * const outside = CvOUTSIDE(cv);
PADLIST* const padlist = CvPADLIST(cv);
PERL_ARGS_ASSERT_CV_DUMP;
@ -1878,9 +1877,15 @@ S_cv_dump(pTHX_ const CV *cv, const char *title)
: CvUNIQUE(outside) ? "UNIQUE"
: CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
PerlIO_printf(Perl_debug_log,
if (!CvISXSUB(cv)) {
/* SVPADLIST(cv) will fail an assert if CvISXSUB(cv) is true,
* and if the assert is removed this code will SEGV. XSUBs don't
* have padlists I believe - Yves */
PADLIST* const padlist = CvPADLIST(cv);
PerlIO_printf(Perl_debug_log,
" PADLIST = 0x%" UVxf "\n", PTR2UV(padlist));
do_dump_pad(1, Perl_debug_log, padlist, 1);
do_dump_pad(1, Perl_debug_log, padlist, 1);
}
}
#endif /* DEBUGGING */

10
t/run/switchDx.t
View File

@ -14,7 +14,7 @@ skip_all "DEBUGGING build required"
unless $::Config{ccflags} =~ /(?<!\S)-DDEBUGGING(?!\S)/
or $^O eq 'VMS' && $::Config{usedebugging_perl} eq 'Y';
plan tests => 8;
plan tests => 9;
END {
unlink $perlio_log;
@ -47,4 +47,10 @@ END {
{ stderr => 1, switches => [ '-TDi' ] },
"Perlio debug output to STDERR with -TDi (no PERLIO_DEBUG)");
}
{
# -DXv tests
fresh_perl_like('{ my $n=1; *foo= sub () { $n }; }',
qr/To: CV=0x[a-f0-9]+ \(ANON\), OUTSIDE=0x0 \(null\)/,
{ stderr => 1, switches => [ '-DXv' ] },
"-DXv does not assert when dumping anonymous constant sub");
}