diff --git a/MANIFEST b/MANIFEST index 7db1f4610f26..ed35c4d1d516 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6305,6 +6305,7 @@ t/op/cproto.t Check builtin prototypes t/op/crypt.t See if crypt works t/op/current_sub.t __SUB__ tests t/op/dbm.t See if dbmopen/dbmclose work +t/op/debug.t Test mechanisms used by the debugger t/op/decl-refs.t See if my \$foo works t/op/defer.t See if defer blocks work t/op/defined.t See if defined() edge cases work diff --git a/pod/perldelta.pod b/pod/perldelta.pod index baf1d278054a..90be67b5bd38 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -366,7 +366,16 @@ manager will later use a regex to expand these into links. =item * -XXX +In some cases an C would not add integer parts to the source +lines saved by the debugger. [GH #23151] + +=item * + +Save debugger lines as C SVs rather than as C SVs as they +don't need magic, aren't blessed and don't need to store a floating +point part. This should save 24 bytes per stored line for 64-bit +systems, more for C<-Duselongdouble> or C<-Dusequadmath> builds. +Discussed in [GH #23171]. =back diff --git a/pp_ctl.c b/pp_ctl.c index c9419ae79fec..70a53f06fc72 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3735,7 +3735,7 @@ S_save_lines(pTHX_ AV *array, SV *sv) while (s && s < send) { const char *t; - SV * const tmpstr = newSV_type(SVt_PVMG); + SV * const tmpstr = newSV_type(SVt_PVIV); t = (const char *)memchr(s, '\n', send - s); if (t) @@ -3744,6 +3744,9 @@ S_save_lines(pTHX_ AV *array, SV *sv) t = send; sv_setpvn_fresh(tmpstr, s, t - s); + /* not breakable until we compile a COP for it */ + SvIV_set(tmpstr, 0); + SvIOK_on(tmpstr); av_store(array, line++, tmpstr); s = t; } diff --git a/t/op/debug.t b/t/op/debug.t new file mode 100644 index 000000000000..d0dcb03a1529 --- /dev/null +++ b/t/op/debug.t @@ -0,0 +1,124 @@ +#!./perl + +# intended for testing language mechanisms that debuggers use not for +# testing the debugger itself + +BEGIN { + chdir 't' if -d 't'; + require "./test.pl"; + set_up_inc( qw(. ../lib) ); +} + +use strict; +use warnings; + +SKIP: +{ + skip_if_miniperl("need XS", 1); + # github 23151 + # trivial debugger + local $ENV{PERL5DB} = 'sub DB::DB {}'; + # eval code trimmed from code generated by Sub::Quote + fresh_perl_is(<<'CODE', <<'EXPECT', +use B qw(SVf_IOK); + +sub _do_eval { + eval $_[0] or die $!; +} + +_do_eval(<<'EVAL'); +{ + sub table { + } +} +1; +EVAL + +# look for lines that don't have an IV set +my ($f) = grep /\(eval/, keys %::; +my $x = $::{$f}; +my $lineno = 0; +for my $l (@$x) { + if ($l) { + my $b = B::svref_2object(\$l); + if (!($b->FLAGS & SVf_IOK)) { + print "No IV for $f line $lineno: $l\n"; + last + } + } + ++$lineno; +} + +print "Done\n"; +CODE +Done +EXPECT + { + switches => [ '-d' ], + stderr => 1, + }, + "saved lines all have an IV" + ); +} + +SKIP: +{ + # Historically lines were stored as PVMG, but we don't need + # magic on these lines. + # + # This checks that none of these lines get upgraded, ie. that + # we don't need them to be PVMG + # + # If this test fails perhaps we do need to make them PVMG + # and toke.c:S_update_debugger_info and pp_ctl.c:S_save_lines + # can be switched back to using SVt_PVMG and this test + # removed. + # + # See https://github.com/Perl/perl5/pull/23171#issuecomment-2780007725 + skip_if_miniperl("need B"); + local $ENV{PERL5DB} = 'sub DB::DB {}'; + fresh_perl_is(<<'CODE', <<'EXPECT', +use B; + +sub _do_eval { + eval $_[0] or die $!; +} + +_do_eval(<<'EVAL'); + +sub some_code { + print "Hello"; +} + +1; +EVAL + +# check if any lines have been upgraded from PVIV +my @files = grep /^_ [ '-d' ], + stderr => 1, + }, + "saved lines are all PVIV" + ); +} + +done_testing(); diff --git a/toke.c b/toke.c index 8fb5f83b7b88..e6acb5a70177 100644 --- a/toke.c +++ b/toke.c @@ -2012,10 +2012,11 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len) AV *av = CopFILEAVx(PL_curcop); if (av) { SV * sv; - if (PL_parser->preambling == NOLINE) sv = newSV_type(SVt_PVMG); + if (PL_parser->preambling == NOLINE) + sv = newSV_type(SVt_PVIV); else { sv = *av_fetch(av, 0, 1); - SvUPGRADE(sv, SVt_PVMG); + SvUPGRADE(sv, SVt_PVIV); } if (!SvPOK(sv)) SvPVCLEAR(sv); if (orig_sv)