Skip to content

Commit 910f35f

Browse files
tonycozmauke
authored andcommitted
eval: ensure debugging saved lines have an IV part
perldebguts documents that the lines stored in @{"_<$filename"} arrays have a numeric value in addition to the text of the source, ensure that is true for evals. Non-zero IV values indicate the lines are breakable (they represent the address of the COP for that line) Fixes #23151
1 parent 135abef commit 910f35f

File tree

3 files changed

+68
-0
lines changed

3 files changed

+68
-0
lines changed

MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6307,6 +6307,7 @@ t/op/cproto.t Check builtin prototypes
63076307
t/op/crypt.t See if crypt works
63086308
t/op/current_sub.t __SUB__ tests
63096309
t/op/dbm.t See if dbmopen/dbmclose work
6310+
t/op/debug.t Test mechanisms used by the debugger
63106311
t/op/decl-refs.t See if my \$foo works
63116312
t/op/defer.t See if defer blocks work
63126313
t/op/defined.t See if defined() edge cases work

pp_ctl.c

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3744,6 +3744,9 @@ S_save_lines(pTHX_ AV *array, SV *sv)
37443744
t = send;
37453745

37463746
sv_setpvn_fresh(tmpstr, s, t - s);
3747+
/* not breakable until we compile a COP for it */
3748+
SvIV_set(tmpstr, 0);
3749+
SvIOK_on(tmpstr);
37473750
av_store(array, line++, tmpstr);
37483751
s = t;
37493752
}

t/op/debug.t

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
#!./perl
2+
3+
# intended for testing language mechanisms that debuggers use not for
4+
# testing the debugger itself
5+
6+
BEGIN {
7+
chdir 't' if -d 't';
8+
require "./test.pl";
9+
set_up_inc( qw(. ../lib) );
10+
}
11+
12+
use strict;
13+
use warnings;
14+
15+
SKIP:
16+
{
17+
skip_if_miniperl("need XS", 1);
18+
# github 23151
19+
# trivial debugger
20+
local $ENV{PERL5DB} = 'sub DB::DB {}';
21+
# eval code trimmed from code generated by Sub::Quote
22+
fresh_perl_is(<<'CODE', <<'EXPECT',
23+
use B qw(SVf_IOK);
24+
25+
sub _do_eval {
26+
eval $_[0] or die $!;
27+
}
28+
29+
_do_eval(<<'EVAL');
30+
{
31+
sub table {
32+
}
33+
}
34+
1;
35+
EVAL
36+
37+
# look for lines that don't have an IV set
38+
my ($f) = grep /\(eval/, keys %::;
39+
my $x = $::{$f};
40+
my $lineno = 0;
41+
for my $l (@$x) {
42+
if ($l) {
43+
my $b = B::svref_2object(\$l);
44+
if (!($b->FLAGS & SVf_IOK)) {
45+
print "No IV for $f line $lineno: $l\n";
46+
last
47+
}
48+
}
49+
++$lineno;
50+
}
51+
52+
print "Done\n";
53+
CODE
54+
Done
55+
EXPECT
56+
{
57+
switches => [ '-d' ],
58+
stderr => 1,
59+
},
60+
"saved lines all have an IV"
61+
);
62+
}
63+
64+
done_testing();

0 commit comments

Comments
 (0)