1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
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 /^_</, keys %::;
for my $f (@files) {
my $lineno = 0;
for my $l (@{$f}) {
if ($l) {
my $b = B::svref_2object(\$l);
if (ref $b ne "B::PVIV") {
print "Not PVIV for $f:$lineno: $l\n";
last
}
}
++$lineno;
}
}
print "Done\n";
CODE
Done
EXPECT
{
switches => [ '-d' ],
stderr => 1,
},
"saved lines are all PVIV"
);
}
done_testing();
|
