This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Tweak Peek.t
[perl5.git] / ext / Devel-Peek / t / Peek.t
CommitLineData
99331854 1#!./perl -T
9ec58fb7
JH
2
3BEGIN {
9ec58fb7 4 require Config; import Config;
e7ecf62c 5 if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) {
9ec58fb7
JH
6 print "1..0 # Skip: Devel::Peek was not built\n";
7 exit 0;
8 }
0eb335df
BF
9 {
10 package t;
11 my $core = !!$ENV{PERL_CORE};
12 require($core ? '../../t/test.pl' : './t/test.pl');
13 }
9ec58fb7
JH
14}
15
06a5cade 16use Test::More;
e7ecf62c 17
9248c45a
JH
18use Devel::Peek;
19
9248c45a 20our $DEBUG = 0;
277ddfaf 21open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
9248c45a 22
bfe27a58
NC
23# If I reference any lexicals in this, I get the entire outer subroutine (or
24# MAIN) dumped too, which isn't really what I want, as it's a lot of faff to
25# maintain that.
26format PIE =
27Pie @<<<<<
28$::type
29Good @>>>>>
30$::mmmm
31.
32
bad4ae38
FC
33use constant thr => $Config{useithreads};
34
9248c45a 35sub do_test {
000fd473
NC
36 my $todo = $_[3];
37 my $repeat_todo = $_[4];
38 my $pattern = $_[2];
34b94bc4 39 my $do_eval = $_[5];
277ddfaf
GS
40 if (open(OUT,">peek$$")) {
41 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
34b94bc4
FC
42 if ($do_eval) {
43 my $sub = eval "sub { Dump $_[1] }";
44 $sub->();
45 print STDERR "*****\n";
46 # second dump to compare with the first to make sure nothing
47 # changed.
48 $sub->();
49 }
50 else {
51 Dump($_[1]);
52 print STDERR "*****\n";
53 # second dump to compare with the first to make sure nothing
54 # changed.
55 Dump($_[1]);
56 }
277ddfaf
GS
57 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
58 close(OUT);
9248c45a
JH
59 if (open(IN, "peek$$")) {
60 local $/;
61 $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
8aacddc1 62 $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
fd0854ff 63 # handle DEBUG_LEAKING_SCALARS prefix
d94a5950 64 $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
bf53b3a5 65
000fd473
NC
66 # Need some clear generic mechanism to eliminate (or add) lines
67 # of dump output dependant on perl version. The (previous) use of
68 # things like $IVNV gave the illusion that the string passed in was
69 # a regexp into which variables were interpolated, but this wasn't
70 # actually true as those 'variables' actually also ate the
b7b1e41b 71 # whitespace on the line. So it seems better to mark lines that
000fd473
NC
72 # need to be eliminated. I considered (?# ... ) and (?{ ... }),
73 # but whilst embedded code or comment syntax would keep it as a
74 # legitimate regexp, it still isn't true. Seems easier and clearer
75 # things that look like comments.
76
77 # Could do this is in a s///mge but seems clearer like this:
78 $pattern = join '', map {
79 # If we identify the version condition, take *it* out whatever
bad4ae38 80 s/\s*# (\$].*)$//
000fd473
NC
81 ? (eval $1 ? $_ : '')
82 : $_ # Didn't match, so this line is in
83 } split /^/, $pattern;
84
85 $pattern =~ s/\$PADMY/
86 ($] < 5.009) ? 'PADBUSY,PADMY' : 'PADMY';
87 /mge;
88 $pattern =~ s/\$PADTMP/
89 ($] < 5.009) ? 'PADBUSY,PADTMP' : 'PADTMP';
90 /mge;
2b631c93
NC
91 $pattern =~ s/\$RV/
92 ($] < 5.011) ? 'RV' : 'IV';
93 /mge;
11d7de88 94 $pattern =~ s/^\h+COW_REFCNT = .*\n//mg
e811af66 95 if $Config{ccflags} =~
32ce4ca8
NC
96 /-DPERL_(?:OLD_COPY_ON_WRITE|NO_COW)/
97 || $] < 5.019003;
9248c45a 98 print $pattern, "\n" if $DEBUG;
e9569a7a 99 my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
9248c45a 100 print $dump, "\n" if $DEBUG;
06a5cade
NC
101 like( $dump, qr/\A$pattern\Z/ms, $_[0])
102 or note("line " . (caller)[2]);
e9569a7a 103
000fd473 104 local $TODO = $repeat_todo;
06a5cade
NC
105 is($dump2, $dump, "$_[0] (unchanged by dump)")
106 or note("line " . (caller)[2]);
e9569a7a 107
9248c45a 108 close(IN);
e9569a7a 109
59d8ce62 110 return $1;
9248c45a
JH
111 } else {
112 die "$0: failed to open peek$$: !\n";
113 }
114 } else {
115 die "$0: failed to create peek$$: $!\n";
116 }
117}
118
119our $a;
120our $b;
121my $c;
208edb77 122local $d = 0;
9248c45a 123
e7ecf62c
RGS
124END {
125 1 while unlink("peek$$");
126}
bf53b3a5 127
06a5cade 128do_test('assignment of immediate constant (string)',
9248c45a
JH
129 $a = "foo",
130'SV = PV\\($ADDR\\) at $ADDR
131 REFCNT = 1
7fa949d0 132 FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
9248c45a
JH
133 PV = $ADDR "foo"\\\0
134 CUR = 3
7fa949d0 135 LEN = \\d+
32ce4ca8 136 COW_REFCNT = 1
7fa949d0 137');
9248c45a 138
06a5cade 139do_test('immediate constant (string)',
9248c45a
JH
140 "bar",
141'SV = PV\\($ADDR\\) at $ADDR
142 REFCNT = 1
7fa949d0 143 FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
9248c45a
JH
144 PV = $ADDR "bar"\\\0
145 CUR = 3
7fa949d0 146 LEN = \\d+
32ce4ca8 147 COW_REFCNT = 0
7fa949d0 148');
9248c45a 149
b7b1e41b 150do_test('assignment of immediate constant (integer)',
9248c45a
JH
151 $b = 123,
152'SV = IV\\($ADDR\\) at $ADDR
153 REFCNT = 1
154 FLAGS = \\(IOK,pIOK\\)
155 IV = 123');
156
06a5cade 157do_test('immediate constant (integer)',
9248c45a
JH
158 456,
159'SV = IV\\($ADDR\\) at $ADDR
160 REFCNT = 1
7766e686 161 FLAGS = \\(.*IOK,READONLY,pIOK\\)
9248c45a
JH
162 IV = 456');
163
06a5cade 164do_test('assignment of immediate constant (integer)',
9248c45a
JH
165 $c = 456,
166'SV = IV\\($ADDR\\) at $ADDR
167 REFCNT = 1
000fd473 168 FLAGS = \\($PADMY,IOK,pIOK\\)
9248c45a
JH
169 IV = 456');
170
59d8ce62
NC
171# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
172# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
173# maths is done in floating point always, and this scalar will be an NV.
174# ([NI]) captures the type, referred to by \1 in this regexp and $type for
175# building subsequent regexps.
06a5cade 176my $type = do_test('result of addition',
9248c45a 177 $c + $d,
59d8ce62 178'SV = ([NI])V\\($ADDR\\) at $ADDR
9248c45a 179 REFCNT = 1
f5b4a412
FC
180 FLAGS = \\(PADTMP,\1OK,p\1OK\\) # $] < 5.019003
181 FLAGS = \\(\1OK,p\1OK\\) # $] >=5.019003
59d8ce62 182 \1V = 456');
9248c45a
JH
183
184($d = "789") += 0.1;
185
06a5cade 186do_test('floating point value',
9248c45a 187 $d,
7fa949d0
FC
188 $] < 5.019003
189 || $Config{ccflags} =~ /-DPERL_(?:NO_COW|OLD_COPY_ON_WRITE)/
190 ?
9248c45a
JH
191'SV = PVNV\\($ADDR\\) at $ADDR
192 REFCNT = 1
193 FLAGS = \\(NOK,pNOK\\)
78d00c47 194 IV = \d+
ac634a9a 195 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
9248c45a
JH
196 PV = $ADDR "789"\\\0
197 CUR = 3
7fa949d0
FC
198 LEN = \\d+'
199 :
200'SV = PVNV\\($ADDR\\) at $ADDR
201 REFCNT = 1
202 FLAGS = \\(NOK,pNOK\\)
203 IV = \d+
204 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
205 PV = 0');
9248c45a 206
06a5cade 207do_test('integer constant',
9248c45a
JH
208 0xabcd,
209'SV = IV\\($ADDR\\) at $ADDR
210 REFCNT = 1
28e5dec8
JH
211 FLAGS = \\(.*IOK,READONLY,pIOK\\)
212 IV = 43981');
9248c45a 213
06a5cade 214do_test('undef',
9248c45a
JH
215 undef,
216'SV = NULL\\(0x0\\) at $ADDR
34b94bc4
FC
217 REFCNT = \d+
218 FLAGS = \\(READONLY\\)');
9248c45a 219
06a5cade 220do_test('reference to scalar',
9248c45a 221 \$a,
4df7f6af 222'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
223 REFCNT = 1
224 FLAGS = \\(ROK\\)
225 RV = $ADDR
226 SV = PV\\($ADDR\\) at $ADDR
227 REFCNT = 2
7fa949d0 228 FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
9248c45a
JH
229 PV = $ADDR "foo"\\\0
230 CUR = 3
7fa949d0 231 LEN = \\d+
32ce4ca8 232 COW_REFCNT = 1
7fa949d0 233');
9248c45a 234
59d8ce62
NC
235my $c_pattern;
236if ($type eq 'N') {
237 $c_pattern = '
238 SV = PVNV\\($ADDR\\) at $ADDR
239 REFCNT = 1
240 FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
241 IV = 456
242 NV = 456
243 PV = 0';
244} else {
245 $c_pattern = '
246 SV = IV\\($ADDR\\) at $ADDR
247 REFCNT = 1
248 FLAGS = \\(IOK,pIOK\\)
249 IV = 456';
250}
06a5cade 251do_test('reference to array',
9248c45a 252 [$b,$c],
4df7f6af 253'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
254 REFCNT = 1
255 FLAGS = \\(ROK\\)
256 RV = $ADDR
257 SV = PVAV\\($ADDR\\) at $ADDR
78c72037 258 REFCNT = 1
9248c45a 259 FLAGS = \\(\\)
1bcecb77
NC
260 IV = 0 # $] < 5.009
261 NV = 0 # $] < 5.009
9248c45a
JH
262 ARRAY = $ADDR
263 FILL = 1
264 MAX = 1
265 ARYLEN = 0x0
266 FLAGS = \\(REAL\\)
267 Elt No. 0
268 SV = IV\\($ADDR\\) at $ADDR
269 REFCNT = 1
270 FLAGS = \\(IOK,pIOK\\)
271 IV = 123
59d8ce62 272 Elt No. 1' . $c_pattern);
9248c45a 273
06a5cade 274do_test('reference to hash',
9248c45a 275 {$b=>$c},
4df7f6af 276'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
277 REFCNT = 1
278 FLAGS = \\(ROK\\)
279 RV = $ADDR
280 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 281 REFCNT = [12]
9248c45a 282 FLAGS = \\(SHAREKEYS\\)
1bcecb77
NC
283 IV = 1 # $] < 5.009
284 NV = $FLOAT # $] < 5.009
9248c45a 285 ARRAY = $ADDR \\(0:7, 1:1\\)
b8fa94d8 286 hash quality = 100.0%
9248c45a
JH
287 KEYS = 1
288 FILL = 1
289 MAX = 7
000fd473
NC
290 Elt "123" HASH = $ADDR' . $c_pattern,
291 '',
f3ce8053
FC
292 $] > 5.009 && $] < 5.015
293 && 'The hash iterator used in dump.c sets the OOK flag');
9248c45a 294
06a5cade 295do_test('reference to anon sub with empty prototype',
9248c45a 296 sub(){@_},
4df7f6af 297'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
298 REFCNT = 1
299 FLAGS = \\(ROK\\)
300 RV = $ADDR
301 SV = PVCV\\($ADDR\\) at $ADDR
302 REFCNT = 2
bad4ae38
FC
303 FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC\\) # $] < 5.015 || !thr
304 FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC,DYNFILE\\) # $] >= 5.015 && thr
1bcecb77
NC
305 IV = 0 # $] < 5.009
306 NV = 0 # $] < 5.009
9248c45a
JH
307 PROTOTYPE = ""
308 COMP_STASH = $ADDR\\t"main"
309 START = $ADDR ===> \\d+
310 ROOT = $ADDR
1bcecb77
NC
311 XSUB = 0x0 # $] < 5.009
312 XSUBANY = 0 # $] < 5.009
208edb77 313 GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
084d946d 314 FILE = ".*\\b(?i:peek\\.t)"
000fd473
NC
315 DEPTH = 0(?:
316 MUTEXP = $ADDR
317 OWNER = $ADDR)?
1bcecb77 318 FLAGS = 0x404 # $] < 5.009
bad4ae38
FC
319 FLAGS = 0x490 # $] >= 5.009 && ($] < 5.015 || !thr)
320 FLAGS = 0x1490 # $] >= 5.015 && thr
a3985cdc 321 OUTSIDE_SEQ = \\d+
9248c45a 322 PADLIST = $ADDR
dd2155a4 323 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
9248c45a
JH
324 OUTSIDE = $ADDR \\(MAIN\\)');
325
06a5cade 326do_test('reference to named subroutine without prototype',
9248c45a 327 \&do_test,
4df7f6af 328'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
329 REFCNT = 1
330 FLAGS = \\(ROK\\)
331 RV = $ADDR
332 SV = PVCV\\($ADDR\\) at $ADDR
9856a127 333 REFCNT = (3|4)
2156df4b
FC
334 FLAGS = \\((?:HASEVAL)?\\) # $] < 5.015 || !thr
335 FLAGS = \\(DYNFILE(?:,HASEVAL)?\\) # $] >= 5.015 && thr
1bcecb77
NC
336 IV = 0 # $] < 5.009
337 NV = 0 # $] < 5.009
9248c45a
JH
338 COMP_STASH = $ADDR\\t"main"
339 START = $ADDR ===> \\d+
340 ROOT = $ADDR
1bcecb77
NC
341 XSUB = 0x0 # $] < 5.009
342 XSUBANY = 0 # $] < 5.009
9248c45a 343 GVGV::GV = $ADDR\\t"main" :: "do_test"
084d946d 344 FILE = ".*\\b(?i:peek\\.t)"
bad4ae38
FC
345 DEPTH = 1(?:
346 MUTEXP = $ADDR
347 OWNER = $ADDR)?
2156df4b
FC
348 FLAGS = 0x(?:400)?0 # $] < 5.015 || !thr
349 FLAGS = 0x[145]000 # $] >= 5.015 && thr
a3985cdc 350 OUTSIDE_SEQ = \\d+
9248c45a 351 PADLIST = $ADDR
dd2155a4 352 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
000fd473
NC
353 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$todo"
354 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$repeat_todo"
ee6cee0c 355 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
34b94bc4
FC
356 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$do_eval"
357 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$sub"
000fd473
NC
358 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" # $] < 5.009
359 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 # $] >= 5.009
ee6cee0c 360 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
e9569a7a 361 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2"
9248c45a
JH
362 OUTSIDE = $ADDR \\(MAIN\\)');
363
3ce3ed55 364if ($] >= 5.011) {
e3e400ec 365# note the conditionals on ENGINE and INTFLAGS were introduced in 5.19.9
06a5cade 366do_test('reference to regexp',
3ce3ed55
NC
367 qr(tic),
368'SV = $RV\\($ADDR\\) at $ADDR
369 REFCNT = 1
370 FLAGS = \\(ROK\\)
371 RV = $ADDR
5c35adbb 372 SV = REGEXP\\($ADDR\\) at $ADDR
c2123ae3 373 REFCNT = 1
8d919b0a
FC
374 FLAGS = \\(OBJECT,POK,FAKE,pPOK\\) # $] < 5.017006
375 FLAGS = \\(OBJECT,FAKE\\) # $] >= 5.017006
fb85c044
KW
376 PV = $ADDR "\\(\\?\\^:tic\\)"
377 CUR = 8
8d919b0a 378 LEN = 0 # $] < 5.017006
d63e6659
DM
379 STASH = $ADDR\\t"Regexp"'
380. ($] < 5.013 ? '' :
381'
dbc200c5 382 COMPFLAGS = 0x0 \(\)
d63e6659 383 EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
e3e400ec
YO
384(?: ENGINE = $ADDR \(STANDARD\)
385)? INTFLAGS = 0x0(?: \(\))?
d63e6659
DM
386 NPARENS = 0
387 LASTPAREN = 0
388 LASTCLOSEPAREN = 0
389 MINLEN = 3
390 MINLENRET = 3
391 GOFS = 0
392 PRE_PREFIX = 4
d63e6659 393 SUBLEN = 0
6502e081
DM
394 SUBOFFSET = 0
395 SUBCOFFSET = 0
d63e6659 396 SUBBEG = 0x0
e3e400ec
YO
397(?: ENGINE = $ADDR
398)? MOTHER_RE = $ADDR'
01ffd0f1
FC
399. ($] < 5.019003 ? '' : '
400 SV = REGEXP\($ADDR\) at $ADDR
401 REFCNT = 2
402 FLAGS = \(\)
403 PV = $ADDR "\(\?\^:tic\)"
404 CUR = 8
405 COMPFLAGS = 0x0 \(\)
406 EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
e3e400ec
YO
407(?: ENGINE = $ADDR \(STANDARD\)
408)? INTFLAGS = 0x0(?: \(\))?
01ffd0f1
FC
409 NPARENS = 0
410 LASTPAREN = 0
411 LASTCLOSEPAREN = 0
412 MINLEN = 3
413 MINLENRET = 3
414 GOFS = 0
415 PRE_PREFIX = 4
416 SUBLEN = 0
417 SUBOFFSET = 0
418 SUBCOFFSET = 0
419 SUBBEG = 0x0
e3e400ec
YO
420(?: ENGINE = $ADDR
421)? MOTHER_RE = 0x0
01ffd0f1
FC
422 PAREN_NAMES = 0x0
423 SUBSTRS = $ADDR
424 PPRIVATE = $ADDR
425 OFFS = $ADDR
426 QR_ANONCV = 0x0(?:
427 SAVED_COPY = 0x0)?') . '
d63e6659
DM
428 PAREN_NAMES = 0x0
429 SUBSTRS = $ADDR
430 PPRIVATE = $ADDR
d63c20f2 431 OFFS = $ADDR
c9669de2
FC
432 QR_ANONCV = 0x0(?:
433 SAVED_COPY = 0x0)?'
d63e6659 434));
3ce3ed55 435} else {
06a5cade 436do_test('reference to regexp',
9248c45a 437 qr(tic),
4df7f6af 438'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
439 REFCNT = 1
440 FLAGS = \\(ROK\\)
441 RV = $ADDR
442 SV = PVMG\\($ADDR\\) at $ADDR
443 REFCNT = 1
faf82a0b 444 FLAGS = \\(OBJECT,SMG\\)
9248c45a
JH
445 IV = 0
446 NV = 0
447 PV = 0
448 MAGIC = $ADDR
449 MG_VIRTUAL = $ADDR
14befaf4 450 MG_TYPE = PERL_MAGIC_qr\(r\)
9248c45a 451 MG_OBJ = $ADDR
fb85c044 452 PAT = "\(\?^:tic\)" # $] >= 5.009
1bcecb77 453 REFCNT = 2 # $] >= 5.009
9248c45a 454 STASH = $ADDR\\t"Regexp"');
3ce3ed55 455}
9248c45a 456
06a5cade 457do_test('reference to blessed hash',
9248c45a 458 (bless {}, "Tac"),
4df7f6af 459'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
460 REFCNT = 1
461 FLAGS = \\(ROK\\)
462 RV = $ADDR
463 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 464 REFCNT = [12]
9248c45a 465 FLAGS = \\(OBJECT,SHAREKEYS\\)
1bcecb77
NC
466 IV = 0 # $] < 5.009
467 NV = 0 # $] < 5.009
9248c45a
JH
468 STASH = $ADDR\\t"Tac"
469 ARRAY = 0x0
470 KEYS = 0
471 FILL = 0
e1a7ec8d 472 MAX = 7', '',
f3ce8053
FC
473 $] > 5.009
474 ? $] >= 5.015
475 ? 0
476 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 477 : "Something causes the HV's array to become allocated");
9248c45a 478
06a5cade 479do_test('typeglob',
9248c45a
JH
480 *a,
481'SV = PVGV\\($ADDR\\) at $ADDR
482 REFCNT = 5
000fd473
NC
483 FLAGS = \\(MULTI(?:,IN_PAD)?\\) # $] >= 5.009
484 FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\) # $] < 5.009
485 IV = 0 # $] < 5.009
486 NV = 0 # $] < 5.009
487 PV = 0 # $] < 5.009
488 MAGIC = $ADDR # $] < 5.009
489 MG_VIRTUAL = &PL_vtbl_glob # $] < 5.009
490 MG_TYPE = PERL_MAGIC_glob\(\*\) # $] < 5.009
491 MG_OBJ = $ADDR # $] < 5.009
9248c45a
JH
492 NAME = "a"
493 NAMELEN = 1
494 GvSTASH = $ADDR\\t"main"
495 GP = $ADDR
496 SV = $ADDR
497 REFCNT = 1
498 IO = 0x0
499 FORM = 0x0
500 AV = 0x0
501 HV = 0x0
502 CV = 0x0
503 CVGEN = 0x0
000fd473 504 GPFLAGS = 0x0 # $] < 5.009
9ec58fb7 505 LINE = \\d+
084d946d 506 FILE = ".*\\b(?i:peek\\.t)"
e39917cc 507 FLAGS = $ADDR
9248c45a
JH
508 EGV = $ADDR\\t"a"');
509
cdb2dd7b 510if (ord('A') == 193) {
06a5cade 511do_test('string with Unicode',
cdb2dd7b
JH
512 chr(256).chr(0).chr(512),
513'SV = PV\\($ADDR\\) at $ADDR
514 REFCNT = 1
f5b4a412 515 FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) # $] < 5.019003
7fa949d0 516 FLAGS = \\((?:$PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\) # $] >=5.019003
cdb2dd7b
JH
517 PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
518 CUR = 5
7fa949d0 519 LEN = \\d+
393e2657 520 COW_REFCNT = 1 # $] < 5.019007
7fa949d0 521');
cdb2dd7b 522} else {
06a5cade 523do_test('string with Unicode',
e6abe6d8
JH
524 chr(256).chr(0).chr(512),
525'SV = PV\\($ADDR\\) at $ADDR
526 REFCNT = 1
f5b4a412 527 FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) # $] < 5.019003
7fa949d0 528 FLAGS = \\((?:$PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\) # $] >=5.019003
98c991d1 529 PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
e6abe6d8 530 CUR = 5
7fa949d0 531 LEN = \\d+
393e2657 532 COW_REFCNT = 1 # $] < 5.019007
7fa949d0 533');
cdb2dd7b 534}
e6abe6d8 535
cdb2dd7b 536if (ord('A') == 193) {
06a5cade 537do_test('reference to hash containing Unicode',
cdb2dd7b 538 {chr(256)=>chr(512)},
4df7f6af 539'SV = $RV\\($ADDR\\) at $ADDR
cdb2dd7b
JH
540 REFCNT = 1
541 FLAGS = \\(ROK\\)
542 RV = $ADDR
543 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 544 REFCNT = [12]
b2caaddd 545 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1bcecb77
NC
546 UV = 1 # $] < 5.009
547 NV = $FLOAT # $] < 5.009
cdb2dd7b
JH
548 ARRAY = $ADDR \\(0:7, 1:1\\)
549 hash quality = 100.0%
550 KEYS = 1
551 FILL = 1
552 MAX = 7
6cbfa5b4 553 Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
cdb2dd7b
JH
554 SV = PV\\($ADDR\\) at $ADDR
555 REFCNT = 1
7fa949d0 556 FLAGS = \\(POK,(?:IsCOW,)?pPOK,UTF8\\)
cdb2dd7b
JH
557 PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
558 CUR = 2
7fa949d0 559 LEN = \\d+
393e2657 560 COW_REFCNT = 1 # $] < 5.019007
7fa949d0 561', '',
f3ce8053
FC
562 $] > 5.009
563 ? $] >= 5.015
564 ? 0
565 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 566 : 'sv_length has been called on the element, and cached the result in MAGIC');
cdb2dd7b 567} else {
06a5cade 568do_test('reference to hash containing Unicode',
98c991d1 569 {chr(256)=>chr(512)},
4df7f6af 570'SV = $RV\\($ADDR\\) at $ADDR
98c991d1
JH
571 REFCNT = 1
572 FLAGS = \\(ROK\\)
573 RV = $ADDR
574 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 575 REFCNT = [12]
19692e8d 576 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1bcecb77
NC
577 UV = 1 # $] < 5.009
578 NV = 0 # $] < 5.009
98c991d1
JH
579 ARRAY = $ADDR \\(0:7, 1:1\\)
580 hash quality = 100.0%
581 KEYS = 1
582 FILL = 1
583 MAX = 7
98c991d1
JH
584 Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
585 SV = PV\\($ADDR\\) at $ADDR
586 REFCNT = 1
7fa949d0 587 FLAGS = \\(POK,(?:IsCOW,)?pPOK,UTF8\\)
98c991d1
JH
588 PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
589 CUR = 2
7fa949d0 590 LEN = \\d+
393e2657 591 COW_REFCNT = 1 # $] < 5.019007
7fa949d0 592', '',
f3ce8053
FC
593 $] > 5.009
594 ? $] >= 5.015
595 ? 0
596 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 597 : 'sv_length has been called on the element, and cached the result in MAGIC');
cdb2dd7b 598}
98c991d1 599
99331854
YST
600my $x="";
601$x=~/.??/g;
06a5cade 602do_test('scalar with pos magic',
99331854
YST
603 $x,
604'SV = PVMG\\($ADDR\\) at $ADDR
605 REFCNT = 1
c9669de2 606 FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?pPOK\\)
eed1f77c 607 IV = \d+
99331854
YST
608 NV = 0
609 PV = $ADDR ""\\\0
610 CUR = 0
e811af66 611 LEN = \d+
7fa949d0 612 COW_REFCNT = [12]
99331854
YST
613 MAGIC = $ADDR
614 MG_VIRTUAL = &PL_vtbl_mglob
615 MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
25fdce4a
FC
616 MG_FLAGS = 0x01 # $] < 5.019003
617 MG_FLAGS = 0x41 # $] >=5.019003
618 MINMATCH
619 BYTES # $] >=5.019003
620');
99331854 621
f24fdb76
HS
622#
623# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
624# environment variables may be invisibly case-forced, hence the (?i:PATH)
5e836f43 625# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
12033064
CS
626# Perl 5.18 ensures all env vars end up as strings only, hence the (?:,pIOK)?
627# Perl 5.18 ensures even magic vars have public OK, hence the (?:,POK)?
d9baf692
JM
628# VMS is setting FAKE and READONLY flags. What VMS uses for storing
629# ENV hashes is also not always null terminated.
f24fdb76 630#
284167a5 631if (${^TAINT}) {
bea5cecf
BF
632 # Save and restore PATH, since fresh_perl ends up using that in Windows.
633 my $path = $ENV{PATH};
284167a5
SM
634 do_test('tainted value in %ENV',
635 $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
99331854
YST
636'SV = PVMG\\($ADDR\\) at $ADDR
637 REFCNT = 1
12033064 638 FLAGS = \\(GMG,SMG,RMG(?:,POK)?(?:,pIOK)?,pPOK\\)
99331854
YST
639 IV = 0
640 NV = 0
641 PV = $ADDR "0"\\\0
642 CUR = 1
643 LEN = \d+
644 MAGIC = $ADDR
645 MG_VIRTUAL = &PL_vtbl_envelem
646 MG_TYPE = PERL_MAGIC_envelem\\(e\\)
d25a523c 647(?: MG_FLAGS = 0x01
99331854 648 TAINTEDDIR
143a3e5e
CB
649)? MG_LEN = -?\d+
650 MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
5e836f43 651 SV = PV(?:IV)?\\($ADDR\\) at $ADDR
143a3e5e 652 REFCNT = \d+
02091bd7 653 FLAGS = \\((?:TEMP,)?POK,(?:FAKE,READONLY,)?pPOK\\)
f0fabfd7 654(?: IV = 0
d9baf692 655)? PV = $ADDR "(?i:PATH)"(?:\\\0)?
143a3e5e
CB
656 CUR = \d+
657 LEN = \d+)
99331854
YST
658 MAGIC = $ADDR
659 MG_VIRTUAL = &PL_vtbl_taint
660 MG_TYPE = PERL_MAGIC_taint\\(t\\)');
bea5cecf 661 $ENV{PATH} = $path;
284167a5 662}
99331854 663
06a5cade 664do_test('blessed reference',
6bf47b08 665 bless(\\undef, 'Foobar'),
4df7f6af 666'SV = $RV\\($ADDR\\) at $ADDR
6bf47b08
SR
667 REFCNT = 1
668 FLAGS = \\(ROK\\)
669 RV = $ADDR
670 SV = PVMG\\($ADDR\\) at $ADDR
671 REFCNT = 2
672 FLAGS = \\(OBJECT,ROK\\)
7957ad98
MB
673 IV = -?\d+
674 NV = $FLOAT
6bf47b08
SR
675 RV = $ADDR
676 SV = NULL\\(0x0\\) at $ADDR
677 REFCNT = \d+
678 FLAGS = \\(READONLY\\)
679 PV = $ADDR ""
680 CUR = 0
681 LEN = 0
682 STASH = $ADDR\s+"Foobar"');
b1886099 683
b1886099
NC
684sub const () {
685 "Perl rules";
686}
687
06a5cade 688do_test('constant subroutine',
b1886099 689 \&const,
4df7f6af 690'SV = $RV\\($ADDR\\) at $ADDR
b1886099
NC
691 REFCNT = 1
692 FLAGS = \\(ROK\\)
693 RV = $ADDR
694 SV = PVCV\\($ADDR\\) at $ADDR
695 REFCNT = (2)
bad4ae38
FC
696 FLAGS = \\(POK,pPOK,CONST,ISXSUB\\) # $] < 5.015
697 FLAGS = \\(POK,pPOK,CONST,DYNFILE,ISXSUB\\) # $] >= 5.015
1bcecb77
NC
698 IV = 0 # $] < 5.009
699 NV = 0 # $] < 5.009
b1886099 700 PROTOTYPE = ""
02bd0dfc
FC
701 COMP_STASH = 0x0 # $] < 5.021004
702 COMP_STASH = $ADDR "main" # $] >=5.021004
1bcecb77 703 ROOT = 0x0 # $] < 5.009
b1886099
NC
704 XSUB = $ADDR
705 XSUBANY = $ADDR \\(CONST SV\\)
706 SV = PV\\($ADDR\\) at $ADDR
707 REFCNT = 1
7fa949d0 708 FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
b1886099
NC
709 PV = $ADDR "Perl rules"\\\0
710 CUR = 10
711 LEN = \\d+
32ce4ca8 712 COW_REFCNT = 0
b1886099
NC
713 GVGV::GV = $ADDR\\t"main" :: "const"
714 FILE = ".*\\b(?i:peek\\.t)"
000fd473
NC
715 DEPTH = 0(?:
716 MUTEXP = $ADDR
717 OWNER = $ADDR)?
1bcecb77 718 FLAGS = 0x200 # $] < 5.009
c2485e0c 719 FLAGS = 0xc00 # $] >= 5.009 && $] < 5.013
bad4ae38
FC
720 FLAGS = 0xc # $] >= 5.013 && $] < 5.015
721 FLAGS = 0x100c # $] >= 5.015
b1886099
NC
722 OUTSIDE_SEQ = 0
723 PADLIST = 0x0
724 OUTSIDE = 0x0 \\(null\\)');
2e94196c 725
06a5cade 726do_test('isUV should show on PVMG',
2e94196c
NC
727 do { my $v = $1; $v = ~0; $v },
728'SV = PVMG\\($ADDR\\) at $ADDR
729 REFCNT = 1
730 FLAGS = \\(IOK,pIOK,IsUV\\)
731 UV = \d+
732 NV = 0
733 PV = 0');
c0a413d1 734
06a5cade 735do_test('IO',
c0a413d1
NC
736 *STDOUT{IO},
737'SV = $RV\\($ADDR\\) at $ADDR
738 REFCNT = 1
739 FLAGS = \\(ROK\\)
740 RV = $ADDR
741 SV = PVIO\\($ADDR\\) at $ADDR
742 REFCNT = 3
743 FLAGS = \\(OBJECT\\)
3cf51070 744 IV = 0 # $] < 5.011
1bcecb77 745 NV = 0 # $] < 5.011
d963bf01 746 STASH = $ADDR\s+"IO::File"
c0a413d1
NC
747 IFP = $ADDR
748 OFP = $ADDR
749 DIRP = 0x0
750 LINES = 0
751 PAGE = 0
752 PAGE_LEN = 60
753 LINES_LEFT = 0
754 TOP_GV = 0x0
755 FMT_GV = 0x0
756 BOTTOM_GV = 0x0
1bcecb77 757 SUBPROCESS = 0 # $] < 5.009
c0a413d1 758 TYPE = \'>\'
50a9fad1 759 FLAGS = 0x4');
bfe27a58 760
06a5cade 761do_test('FORMAT',
bfe27a58
NC
762 *PIE{FORMAT},
763'SV = $RV\\($ADDR\\) at $ADDR
764 REFCNT = 1
765 FLAGS = \\(ROK\\)
766 RV = $ADDR
767 SV = PVFM\\($ADDR\\) at $ADDR
768 REFCNT = 2
bad4ae38
FC
769 FLAGS = \\(\\) # $] < 5.015 || !thr
770 FLAGS = \\(DYNFILE\\) # $] >= 5.015 && thr
30ec677d 771 IV = 0 # $] < 5.009
bfe27a58 772 NV = 0 # $] < 5.009
251a4af1
DM
773(?: PV = 0
774)? COMP_STASH = 0x0
bfe27a58
NC
775 START = $ADDR ===> \\d+
776 ROOT = $ADDR
777 XSUB = 0x0 # $] < 5.009
778 XSUBANY = 0 # $] < 5.009
779 GVGV::GV = $ADDR\\t"main" :: "PIE"
bad4ae38 780 FILE = ".*\\b(?i:peek\\.t)"(?:
d3810ef8 781 DEPTH = 0)?(?:
c12100a4 782 MUTEXP = $ADDR
bad4ae38
FC
783 OWNER = $ADDR)?
784 FLAGS = 0x0 # $] < 5.015 || !thr
785 FLAGS = 0x1000 # $] >= 5.015 && thr
bfe27a58 786 OUTSIDE_SEQ = \\d+
d3810ef8 787 LINES = 0 # $] < 5.017_003
bfe27a58
NC
788 PADLIST = $ADDR
789 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
790 OUTSIDE = $ADDR \\(MAIN\\)');
d7d51f4b 791
b7b1e41b 792do_test('blessing to a class with embedded NUL characters',
d7d51f4b
YO
793 (bless {}, "\0::foo::\n::baz::\t::\0"),
794'SV = $RV\\($ADDR\\) at $ADDR
795 REFCNT = 1
796 FLAGS = \\(ROK\\)
797 RV = $ADDR
798 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 799 REFCNT = [12]
d7d51f4b
YO
800 FLAGS = \\(OBJECT,SHAREKEYS\\)
801 IV = 0 # $] < 5.009
802 NV = 0 # $] < 5.009
803 STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0"
804 ARRAY = $ADDR
805 KEYS = 0
806 FILL = 0
e1a7ec8d 807 MAX = 7', '',
f3ce8053
FC
808 $] > 5.009
809 ? $] >= 5.015
810 ? 0
811 : 'The hash iterator used in dump.c sets the OOK flag'
d7d51f4b
YO
812 : "Something causes the HV's array to become allocated");
813
bed53064
NC
814do_test('ENAME on a stash',
815 \%RWOM::,
816'SV = $RV\\($ADDR\\) at $ADDR
817 REFCNT = 1
818 FLAGS = \\(ROK\\)
819 RV = $ADDR
820 SV = PVHV\\($ADDR\\) at $ADDR
821 REFCNT = 2
822 FLAGS = \\(OOK,SHAREKEYS\\)
823 IV = 1 # $] < 5.009
824 NV = $FLOAT # $] < 5.009
0c22a733 825 AUX_FLAGS = 0 # $] > 5.019008
bed53064
NC
826 ARRAY = $ADDR
827 KEYS = 0
9faf471a 828 FILL = 0 \(cached = 0\)
bed53064
NC
829 MAX = 7
830 RITER = -1
831 EITER = 0x0
e1a7ec8d 832 RAND = $ADDR
bed53064
NC
833 NAME = "RWOM"
834 ENAME = "RWOM" # $] > 5.012
835');
836
837*KLANK:: = \%RWOM::;
838
839do_test('ENAMEs on a stash',
840 \%RWOM::,
841'SV = $RV\\($ADDR\\) at $ADDR
842 REFCNT = 1
843 FLAGS = \\(ROK\\)
844 RV = $ADDR
845 SV = PVHV\\($ADDR\\) at $ADDR
846 REFCNT = 3
847 FLAGS = \\(OOK,SHAREKEYS\\)
848 IV = 1 # $] < 5.009
849 NV = $FLOAT # $] < 5.009
0c22a733 850 AUX_FLAGS = 0 # $] > 5.019008
bed53064
NC
851 ARRAY = $ADDR
852 KEYS = 0
9faf471a 853 FILL = 0 \(cached = 0\)
bed53064
NC
854 MAX = 7
855 RITER = -1
856 EITER = 0x0
e1a7ec8d 857 RAND = $ADDR
bed53064
NC
858 NAME = "RWOM"
859 NAMECOUNT = 2 # $] > 5.012
860 ENAME = "RWOM", "KLANK" # $] > 5.012
861');
862
863undef %RWOM::;
864
865do_test('ENAMEs on a stash with no NAME',
866 \%RWOM::,
867'SV = $RV\\($ADDR\\) at $ADDR
868 REFCNT = 1
869 FLAGS = \\(ROK\\)
870 RV = $ADDR
871 SV = PVHV\\($ADDR\\) at $ADDR
872 REFCNT = 3
6acb8aa1
FC
873 FLAGS = \\(OOK,SHAREKEYS\\) # $] < 5.017
874 FLAGS = \\(OOK,OVERLOAD,SHAREKEYS\\) # $] >=5.017
bed53064
NC
875 IV = 1 # $] < 5.009
876 NV = $FLOAT # $] < 5.009
0c22a733 877 AUX_FLAGS = 0 # $] > 5.019008
bed53064
NC
878 ARRAY = $ADDR
879 KEYS = 0
9faf471a 880 FILL = 0 \(cached = 0\)
bed53064
NC
881 MAX = 7
882 RITER = -1
883 EITER = 0x0
e1a7ec8d 884 RAND = $ADDR
bed53064
NC
885 NAMECOUNT = -3 # $] > 5.012
886 ENAME = "RWOM", "KLANK" # $] > 5.012
887');
888
9faf471a
NC
889my %small = ("Perl", "Rules", "Beer", "Foamy");
890my $b = %small;
891do_test('small hash',
892 \%small,
893'SV = $RV\\($ADDR\\) at $ADDR
894 REFCNT = 1
895 FLAGS = \\(ROK\\)
896 RV = $ADDR
897 SV = PVHV\\($ADDR\\) at $ADDR
898 REFCNT = 2
899 FLAGS = \\(PADMY,SHAREKEYS\\)
900 IV = 1 # $] < 5.009
901 NV = $FLOAT # $] < 5.009
902 ARRAY = $ADDR \\(0:[67],.*\\)
903 hash quality = [0-9.]+%
904 KEYS = 2
905 FILL = [12]
906 MAX = 7
907(?: Elt "(?:Perl|Beer)" HASH = $ADDR
908 SV = PV\\($ADDR\\) at $ADDR
909 REFCNT = 1
7fa949d0 910 FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
9faf471a
NC
911 PV = $ADDR "(?:Rules|Foamy)"\\\0
912 CUR = \d+
913 LEN = \d+
32ce4ca8 914 COW_REFCNT = 1
9faf471a
NC
915){2}');
916
917$b = keys %small;
918
919do_test('small hash after keys',
920 \%small,
921'SV = $RV\\($ADDR\\) at $ADDR
922 REFCNT = 1
923 FLAGS = \\(ROK\\)
924 RV = $ADDR
925 SV = PVHV\\($ADDR\\) at $ADDR
926 REFCNT = 2
927 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
928 IV = 1 # $] < 5.009
929 NV = $FLOAT # $] < 5.009
0c22a733 930 AUX_FLAGS = 0 # $] > 5.019008
9faf471a
NC
931 ARRAY = $ADDR \\(0:[67],.*\\)
932 hash quality = [0-9.]+%
933 KEYS = 2
934 FILL = [12] \\(cached = 0\\)
935 MAX = 7
936 RITER = -1
937 EITER = 0x0
938 RAND = $ADDR
939(?: Elt "(?:Perl|Beer)" HASH = $ADDR
940 SV = PV\\($ADDR\\) at $ADDR
941 REFCNT = 1
7fa949d0 942 FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
9faf471a
NC
943 PV = $ADDR "(?:Rules|Foamy)"\\\0
944 CUR = \d+
945 LEN = \d+
32ce4ca8 946 COW_REFCNT = 1
9faf471a
NC
947){2}');
948
949$b = %small;
950
951do_test('small hash after keys and scalar',
952 \%small,
953'SV = $RV\\($ADDR\\) at $ADDR
954 REFCNT = 1
955 FLAGS = \\(ROK\\)
956 RV = $ADDR
957 SV = PVHV\\($ADDR\\) at $ADDR
958 REFCNT = 2
959 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
960 IV = 1 # $] < 5.009
961 NV = $FLOAT # $] < 5.009
0c22a733 962 AUX_FLAGS = 0 # $] > 5.019008
9faf471a
NC
963 ARRAY = $ADDR \\(0:[67],.*\\)
964 hash quality = [0-9.]+%
965 KEYS = 2
966 FILL = ([12]) \\(cached = \1\\)
967 MAX = 7
968 RITER = -1
969 EITER = 0x0
970 RAND = $ADDR
971(?: Elt "(?:Perl|Beer)" HASH = $ADDR
972 SV = PV\\($ADDR\\) at $ADDR
973 REFCNT = 1
7fa949d0 974 FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
9faf471a
NC
975 PV = $ADDR "(?:Rules|Foamy)"\\\0
976 CUR = \d+
977 LEN = \d+
32ce4ca8 978 COW_REFCNT = 1
9faf471a
NC
979){2}');
980
981# This should immediately start with the FILL cached correctly.
982my %large = (0..1999);
983$b = %large;
984do_test('large hash',
985 \%large,
986'SV = $RV\\($ADDR\\) at $ADDR
987 REFCNT = 1
988 FLAGS = \\(ROK\\)
989 RV = $ADDR
990 SV = PVHV\\($ADDR\\) at $ADDR
991 REFCNT = 2
992 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
993 IV = 1 # $] < 5.009
994 NV = $FLOAT # $] < 5.009
0c22a733 995 AUX_FLAGS = 0 # $] > 5.019008
9faf471a
NC
996 ARRAY = $ADDR \\(0:\d+,.*\\)
997 hash quality = \d+\\.\d+%
998 KEYS = 1000
999 FILL = (\d+) \\(cached = \1\\)
1000 MAX = 1023
1001 RITER = -1
1002 EITER = 0x0
1003 RAND = $ADDR
1004 Elt .*
1005');
1006
34b94bc4
FC
1007# Dump with arrays, hashes, and operator return values
1008@array = 1..3;
1009do_test('Dump @array', '@array', <<'ARRAY', '', '', 1);
1010SV = PVAV\($ADDR\) at $ADDR
1011 REFCNT = 1
1012 FLAGS = \(\)
1013 ARRAY = $ADDR
1014 FILL = 2
1015 MAX = 3
1016 ARYLEN = 0x0
1017 FLAGS = \(REAL\)
1018 Elt No. 0
1019 SV = IV\($ADDR\) at $ADDR
1020 REFCNT = 1
1021 FLAGS = \(IOK,pIOK\)
1022 IV = 1
1023 Elt No. 1
1024 SV = IV\($ADDR\) at $ADDR
1025 REFCNT = 1
1026 FLAGS = \(IOK,pIOK\)
1027 IV = 2
1028 Elt No. 2
1029 SV = IV\($ADDR\) at $ADDR
1030 REFCNT = 1
1031 FLAGS = \(IOK,pIOK\)
1032 IV = 3
1033ARRAY
e864b323
DM
1034
1035do_test('Dump @array,1', '@array,1', <<'ARRAY', '', '', 1);
1036SV = PVAV\($ADDR\) at $ADDR
1037 REFCNT = 1
1038 FLAGS = \(\)
1039 ARRAY = $ADDR
1040 FILL = 2
1041 MAX = 3
1042 ARYLEN = 0x0
1043 FLAGS = \(REAL\)
1044 Elt No. 0
1045 SV = IV\($ADDR\) at $ADDR
1046 REFCNT = 1
1047 FLAGS = \(IOK,pIOK\)
1048 IV = 1
1049ARRAY
1050
34b94bc4
FC
1051%hash = 1..2;
1052do_test('Dump %hash', '%hash', <<'HASH', '', '', 1);
1053SV = PVHV\($ADDR\) at $ADDR
1054 REFCNT = 1
1055 FLAGS = \(SHAREKEYS\)
1056 ARRAY = $ADDR \(0:7, 1:1\)
1057 hash quality = 100.0%
1058 KEYS = 1
1059 FILL = 1
1060 MAX = 7
1061 Elt "1" HASH = $ADDR
1062 SV = IV\($ADDR\) at $ADDR
1063 REFCNT = 1
1064 FLAGS = \(IOK,pIOK\)
1065 IV = 2
1066HASH
e864b323 1067
34b94bc4
FC
1068$_ = "hello";
1069do_test('rvalue substr', 'substr $_, 1, 2', <<'SUBSTR', '', '', 1);
1070SV = PV\($ADDR\) at $ADDR
1071 REFCNT = 1
1072 FLAGS = \(PADTMP,POK,pPOK\)
1073 PV = $ADDR "el"\\0
1074 CUR = 2
1075 LEN = \d+
1076SUBSTR
1077
313efa90
FC
1078# Dump with no arguments
1079eval 'Dump';
1080like $@, qr/^Not enough arguments for Devel::Peek::Dump/, 'Dump;';
1081eval 'Dump()';
1082like $@, qr/^Not enough arguments for Devel::Peek::Dump/, 'Dump()';
1083
4ab5bd5f 1084SKIP: {
b59747ac 1085 skip "Not built with usemymalloc", 2
4ab5bd5f
FC
1086 unless $Config{usemymalloc} eq 'y';
1087 my $x = __PACKAGE__;
1088 ok eval { fill_mstats($x); 1 }, 'fill_mstats on COW scalar'
1089 or diag $@;
b59747ac
FC
1090 my $y;
1091 ok eval { fill_mstats($y); 1 }, 'fill_mstats on undef scalar';
4ab5bd5f
FC
1092}
1093
bc9a5256
NC
1094# This is more a test of fbm_compile/pp_study (non) interaction than dumping
1095# prowess, but short of duplicating all the gubbins of this file, I can't see
1096# a way to make a better place for it:
1097
ccbcbb3d
NC
1098use constant {
1099 perl => 'rules',
1100 beer => 'foamy',
1101};
0a0c4b76
NC
1102
1103unless ($Config{useithreads}) {
1104 # These end up as copies in pads under ithreads, which rather defeats the
1105 # the point of what we're trying to test here.
1106
1107 do_test('regular string constant', perl,
1108'SV = PV\\($ADDR\\) at $ADDR
bc9a5256 1109 REFCNT = 5
e811af66 1110 FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
0a0c4b76
NC
1111 PV = $ADDR "rules"\\\0
1112 CUR = 5
1113 LEN = \d+
32ce4ca8 1114 COW_REFCNT = 0
0a0c4b76
NC
1115');
1116
1117 eval 'index "", perl';
1118
1119 # FIXME - really this shouldn't say EVALED. It's a false posistive on
1120 # 0x40000000 being used for several things, not a flag for "I'm in a string
1121 # eval"
1122
1123 do_test('string constant now an FBM', perl,
c13a5c80 1124'SV = PVMG\\($ADDR\\) at $ADDR
bc9a5256 1125 REFCNT = 5
e811af66 1126 FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
bc9a5256
NC
1127 PV = $ADDR "rules"\\\0
1128 CUR = 5
1129 LEN = \d+
32ce4ca8 1130 COW_REFCNT = 0
bc9a5256 1131 MAGIC = $ADDR
b76b0bf9 1132 MG_VIRTUAL = &PL_vtbl_regexp
bc9a5256 1133 MG_TYPE = PERL_MAGIC_bm\\(B\\)
2bda37ba
NC
1134 MG_LEN = 256
1135 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
1136 RARE = \d+ # $] < 5.019002
1137 PREVIOUS = 1 # $] < 5.019002
bc9a5256
NC
1138 USEFUL = 100
1139');
1140
1141 is(study perl, '', "Not allowed to study an FBM");
1142
1143 do_test('string constant still an FBM', perl,
c13a5c80 1144'SV = PVMG\\($ADDR\\) at $ADDR
bc9a5256 1145 REFCNT = 5
e811af66 1146 FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
0a0c4b76
NC
1147 PV = $ADDR "rules"\\\0
1148 CUR = 5
1149 LEN = \d+
32ce4ca8 1150 COW_REFCNT = 0
0a0c4b76 1151 MAGIC = $ADDR
b76b0bf9 1152 MG_VIRTUAL = &PL_vtbl_regexp
0a0c4b76 1153 MG_TYPE = PERL_MAGIC_bm\\(B\\)
2bda37ba
NC
1154 MG_LEN = 256
1155 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
1156 RARE = \d+ # $] < 5.019002
1157 PREVIOUS = 1 # $] < 5.019002
0a0c4b76
NC
1158 USEFUL = 100
1159');
ccbcbb3d
NC
1160
1161 do_test('regular string constant', beer,
1162'SV = PV\\($ADDR\\) at $ADDR
4185c919 1163 REFCNT = 6
e811af66 1164 FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
ccbcbb3d
NC
1165 PV = $ADDR "foamy"\\\0
1166 CUR = 5
1167 LEN = \d+
32ce4ca8 1168 COW_REFCNT = 0
ccbcbb3d
NC
1169');
1170
a58a85fa
AMS
1171 is(study beer, 1, "Our studies were successful");
1172
1173 do_test('string constant quite unaffected', beer, 'SV = PV\\($ADDR\\) at $ADDR
1174 REFCNT = 6
e811af66 1175 FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
a58a85fa
AMS
1176 PV = $ADDR "foamy"\\\0
1177 CUR = 5
1178 LEN = \d+
32ce4ca8 1179 COW_REFCNT = 0
a58a85fa
AMS
1180');
1181
4185c919 1182 my $want = 'SV = PVMG\\($ADDR\\) at $ADDR
4265b45d 1183 REFCNT = 6
e811af66 1184 FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
4265b45d
NC
1185 PV = $ADDR "foamy"\\\0
1186 CUR = 5
1187 LEN = \d+
32ce4ca8 1188 COW_REFCNT = 0
4265b45d 1189 MAGIC = $ADDR
0177730e 1190 MG_VIRTUAL = &PL_vtbl_regexp
a58a85fa
AMS
1191 MG_TYPE = PERL_MAGIC_bm\\(B\\)
1192 MG_LEN = 256
1193 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
1194 RARE = \d+ # $] < 5.019002
1195 PREVIOUS = \d+ # $] < 5.019002
a58a85fa 1196 USEFUL = 100
4185c919
NC
1197';
1198
4265b45d
NC
1199 is (eval 'index "not too foamy", beer', 8, 'correct index');
1200
a58a85fa 1201 do_test('string constant now FBMed', beer, $want);
4185c919
NC
1202
1203 my $pie = 'good';
1204
1205 is(study $pie, 1, "Our studies were successful");
1206
a58a85fa 1207 do_test('string constant still FBMed', beer, $want);
4185c919 1208
a58a85fa 1209 do_test('second string also unaffected', $pie, 'SV = PV\\($ADDR\\) at $ADDR
4185c919 1210 REFCNT = 1
abbcae52 1211 FLAGS = \\(PADMY,POK,(?:IsCOW,)?pPOK\\)
4185c919
NC
1212 PV = $ADDR "good"\\\0
1213 CUR = 4
fb1c5e87
NC
1214 LEN = \d+
1215 COW_REFCNT = 1
ccbcbb3d 1216');
0a0c4b76
NC
1217}
1218
a58a85fa 1219# (One block of study tests removed when study was made a no-op.)
72de20cd 1220
486ffce2
FC
1221{
1222 open(OUT,">peek$$") or die "Failed to open peek $$: $!";
1223 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
1224 DeadCode();
1225 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
1226 pass "no crash with DeadCode";
7bf23f34 1227 close OUT;
486ffce2 1228}
e3e400ec 1229# note the conditionals on ENGINE and INTFLAGS were introduced in 5.19.9
8cdde9f8
NC
1230do_test('UTF-8 in a regular expression',
1231 qr/\x{100}/,
1232'SV = IV\($ADDR\) at $ADDR
1233 REFCNT = 1
1234 FLAGS = \(ROK\)
1235 RV = $ADDR
1236 SV = REGEXP\($ADDR\) at $ADDR
1237 REFCNT = 1
1238 FLAGS = \(OBJECT,FAKE,UTF8\)
1239 PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
1240 CUR = 13
1241 STASH = $ADDR "Regexp"
dbc200c5 1242 COMPFLAGS = 0x0 \(\)
8cdde9f8 1243 EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
e3e400ec
YO
1244(?: ENGINE = $ADDR \(STANDARD\)
1245)? INTFLAGS = 0x0(?: \(\))?
8cdde9f8
NC
1246 NPARENS = 0
1247 LASTPAREN = 0
1248 LASTCLOSEPAREN = 0
1249 MINLEN = 1
1250 MINLENRET = 1
1251 GOFS = 0
1252 PRE_PREFIX = 5
1253 SUBLEN = 0
1254 SUBOFFSET = 0
1255 SUBCOFFSET = 0
1256 SUBBEG = 0x0
e3e400ec
YO
1257(?: ENGINE = $ADDR
1258)? MOTHER_RE = $ADDR'
01ffd0f1
FC
1259. ($] < 5.019003 ? '' : '
1260 SV = REGEXP\($ADDR\) at $ADDR
1261 REFCNT = 2
1262 FLAGS = \(UTF8\)
1263 PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
1264 CUR = 13
1265 COMPFLAGS = 0x0 \(\)
1266 EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
e3e400ec
YO
1267(?: ENGINE = $ADDR \(STANDARD\)
1268)? INTFLAGS = 0x0(?: \(\))?
01ffd0f1
FC
1269 NPARENS = 0
1270 LASTPAREN = 0
1271 LASTCLOSEPAREN = 0
1272 MINLEN = 1
1273 MINLENRET = 1
1274 GOFS = 0
1275 PRE_PREFIX = 5
1276 SUBLEN = 0
1277 SUBOFFSET = 0
1278 SUBCOFFSET = 0
1279 SUBBEG = 0x0
e3e400ec
YO
1280(?: ENGINE = $ADDR
1281)? MOTHER_RE = 0x0
01ffd0f1
FC
1282 PAREN_NAMES = 0x0
1283 SUBSTRS = $ADDR
1284 PPRIVATE = $ADDR
1285 OFFS = $ADDR
1286 QR_ANONCV = 0x0(?:
1287 SAVED_COPY = 0x0)?') . '
8cdde9f8
NC
1288 PAREN_NAMES = 0x0
1289 SUBSTRS = $ADDR
1290 PPRIVATE = $ADDR
1291 OFFS = $ADDR
09af2132
DM
1292 QR_ANONCV = 0x0(?:
1293 SAVED_COPY = 0x0)?
8cdde9f8
NC
1294');
1295
da1929e7
TC
1296{ # perl #117793: Extend SvREFCNT* to work on any perl variable type
1297 my %hash;
1298 my $base_count = Devel::Peek::SvREFCNT(%hash);
1299 my $ref = \%hash;
1300 is(Devel::Peek::SvREFCNT(%hash), $base_count + 1, "SvREFCNT on non-scalar");
e4c0574e 1301 ok(!eval { &Devel::Peek::SvREFCNT(1) }, "requires prototype");
da1929e7 1302}
0eb335df
BF
1303{
1304# utf8 tests
1305use utf8;
1306
1307sub _dump {
1308 open(OUT,">peek$$") or die $!;
1309 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
559d64fb 1310 Dump($_[0]);
0eb335df
BF
1311 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
1312 close(OUT);
1313 open(IN, "peek$$") or die $!;
1314 my $dump = do { local $/; <IN> };
1315 close(IN);
559d64fb 1316 1 while unlink "peek$$";
0eb335df
BF
1317 return $dump;
1318}
1319
1320sub _get_coderef {
1321 my $x = $_[0];
1322 utf8::upgrade($x);
1323 eval "sub $x {}; 1" or die $@;
1324 return *{$x}{CODE};
1325}
1326
1327like(
1328 _dump(_get_coderef("\x{df}::\xdf")),
1329 qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\xdf" :: "\xdf"/,
1330 "GVGV's are correctly escaped for latin1 :: latin1",
1331);
1332
1333like(
1334 _dump(_get_coderef("\x{30cd}::\x{30cd}")),
1335 qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\x{30cd}" :: "\x{30cd}"/,
1336 "GVGV's are correctly escaped for UTF8 :: UTF8",
1337);
1338
1339like(
1340 _dump(_get_coderef("\x{df}::\x{30cd}")),
1341 qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\xdf" :: "\x{30cd}"/,
1342 "GVGV's are correctly escaped for latin1 :: UTF8",
1343);
1344
1345like(
1346 _dump(_get_coderef("\x{30cd}::\x{df}")),
1347 qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\x{30cd}" :: "\xdf"/,
1348 "GVGV's are correctly escaped for UTF8 :: latin1",
1349);
1350
1351like(
1352 _dump(_get_coderef("\x{30cb}::\x{df}::\x{30cd}")),
1353 qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\x{30cb}::\x{df}" :: "\x{30cd}"/,
1354 "GVGV's are correctly escaped for UTF8 :: latin 1 :: UTF8",
1355);
1356
1357my $dump = _dump(*{"\x{30cb}::\x{df}::\x{30dc}"});
1358
1359like(
1360 $dump,
1361 qr/NAME = \Q"\x{30dc}"/,
1362 "NAME is correctly escaped for UTF8 globs",
1363);
1364
1365like(
1366 $dump,
1367 qr/GvSTASH = 0x[[:xdigit:]]+\s+\Q"\x{30cb}::\x{df}"/,
1368 "GvSTASH is correctly escaped for UTF8 globs"
1369);
1370
1371like(
1372 $dump,
1373 qr/EGV = 0x[[:xdigit:]]+\s+\Q"\x{30dc}"/,
1374 "EGV is correctly escaped for UTF8 globs"
1375);
1376
1377$dump = _dump(*{"\x{df}::\x{30cc}"});
1378
1379like(
1380 $dump,
1381 qr/NAME = \Q"\x{30cc}"/,
1382 "NAME is correctly escaped for UTF8 globs with latin1 stashes",
1383);
1384
1385like(
1386 $dump,
1387 qr/GvSTASH = 0x[[:xdigit:]]+\s+\Q"\xdf"/,
1388 "GvSTASH is correctly escaped for UTF8 globs with latin1 stashes"
1389);
1390
1391like(
1392 $dump,
1393 qr/EGV = 0x[[:xdigit:]]+\s+\Q"\x{30cc}"/,
1394 "EGV is correctly escaped for UTF8 globs with latin1 stashes"
1395);
1396
1397like(
1398 _dump(bless {}, "\0::\1::\x{30cd}"),
1399 qr/STASH = 0x[[:xdigit:]]+\s+\Q"\0::\x{01}::\x{30cd}"/,
1400 "STASH for blessed hashrefs is correct"
1401);
1402
1403BEGIN { $::{doof} = "\0\1\x{30cd}" }
1404like(
1405 _dump(\&doof),
1406 qr/PROTOTYPE = \Q"\0\x{01}\x{30cd}"/,
1407 "PROTOTYPE is escaped correctly"
1408);
1409
1410{
1411 my $coderef = eval <<"EOP";
1412 use feature 'lexical_subs';
1413 no warnings 'experimental::lexical_subs';
1414 my sub bar (\$\x{30cd}) {1}; \\&bar
1415EOP
1416 like(
1417 _dump($coderef),
1418 qr/PROTOTYPE = "\$\Q\x{30cd}"/,
1419 "PROTOTYPE works on lexical subs"
1420 )
1421}
1422
0eb335df 1423sub get_outside {
01d7523a 1424 eval "sub $_[0] { my \$x; \$x++; return sub { eval q{\$x} } } $_[0]()";
0eb335df 1425}
559d64fb 1426sub basic { my $x; return eval q{sub { eval q{$x} }} }
0eb335df 1427like(
559d64fb 1428 _dump(basic()),
0eb335df
BF
1429 qr/OUTSIDE = 0x[[:xdigit:]]+\s+\Q(basic)/,
1430 'OUTSIDE works'
1431);
1432
1433like(
1434 _dump(get_outside("\x{30ce}")),
1435 qr/OUTSIDE = 0x[[:xdigit:]]+\s+\Q(\x{30ce})/,
1436 'OUTSIDE + UTF8 works'
1437);
0eb335df
BF
1438
1439# TODO AUTOLOAD = stashname, which requires using a XS autoload
1440# and calling Dump() on the cv
1441
1442
1443
1444sub test_utf8_stashes {
1445 my ($stash_name, $test) = @_;
1446
1447 $dump = _dump(\%{"${stash_name}::"});
1448
1449 my $format = utf8::is_utf8($stash_name) ? '\x{%2x}' : '\x%2x';
1450 $escaped_stash_name = join "", map {
1451 $_ eq ':' ? $_ : sprintf $format, ord $_
1452 } split //, $stash_name;
1453
1454 like(
1455 $dump,
1456 qr/\QNAME = "$escaped_stash_name"/,
1457 "NAME is correct escaped for $test"
1458 );
1459
1460 like(
1461 $dump,
1462 qr/\QENAME = "$escaped_stash_name"/,
1463 "ENAME is correct escaped for $test"
1464 );
1465}
1466
1467for my $test (
1468 [ "\x{30cd}", "UTF8 stashes" ],
1469 [ "\x{df}", "latin 1 stashes" ],
1470 [ "\x{df}::\x{30cd}", "latin1 + UTF8 stashes" ],
1471 [ "\x{30cd}::\x{df}", "UTF8 + latin1 stashes" ],
1472) {
1473 test_utf8_stashes(@$test);
1474}
1475
1476}
1477
c695838a 1478my $runperl_args = { switches => ['-Ilib'] };
0eb335df
BF
1479sub test_DumpProg {
1480 my ($prog, $expected, $name, $test) = @_;
1481 $test ||= 'like';
1482
1483 my $u = 'use Devel::Peek "DumpProg"; DumpProg();';
1484
1485 # Interface between Test::Builder & test.pl
1486 my $builder = Test::More->builder();
1487 t::curr_test($builder->current_test() + 1);
1488
1489 utf8::encode($prog);
1490
1491 if ( $test eq 'is' ) {
c695838a 1492 t::fresh_perl_is($prog . $u, $expected, $runperl_args, $name)
0eb335df
BF
1493 }
1494 else {
c695838a 1495 t::fresh_perl_like($prog . $u, $expected, $runperl_args, $name)
0eb335df
BF
1496 }
1497
1498 $builder->current_test(t::curr_test() - 1);
1499}
1500
1501my $threads = $Config{'useithreads'};
1502
1503for my $test (
1504[
1505 "package test;",
1506 qr/PACKAGE = "test"/,
1507 "DumpProg() + package declaration"
1508],
1509[
1510 "use utf8; package \x{30cd};",
1511 qr/PACKAGE = "\\x\Q{30cd}"/,
1512 "DumpProg() + UTF8 package declaration"
1513],
1514[
1515 "use utf8; sub \x{30cc}::\x{30cd} {1}; \x{30cc}::\x{30cd};",
1516 ($threads ? qr/PADIX = \d+/ : qr/GV = \Q\x{30cc}::\x{30cd}\E/)
1517],
1518[
1519 "use utf8; \x{30cc}: { last \x{30cc} }",
1520 qr/LABEL = \Q"\x{30cc}"/
1521],
1522)
1523{
1524 test_DumpProg(@$test);
1525}
1526
1527my $e = <<'EODUMP';
1528dumpindent is 4 at - line 1.
1529{
15301 TYPE = leave ===> NULL
1531 TARG = 1
29e61fd9 1532 FLAGS = (VOID,KIDS,PARENS,SLABBED,LASTSIB)
f3574cc6 1533 PRIVATE = (REFC)
0eb335df
BF
1534 REFCNT = 1
1535 {
15362 TYPE = enter ===> 3
1537 FLAGS = (UNKNOWN,SLABBED)
1538 }
1539 {
15403 TYPE = nextstate ===> 4
1541 FLAGS = (VOID,SLABBED)
1542 LINE = 1
1543 PACKAGE = "t"
1544 }
1545 {
15465 TYPE = entersub ===> 1
075ddd1f 1547 TARG = 1
29e61fd9 1548 FLAGS = (VOID,KIDS,STACKED,SLABBED,LASTSIB)
f3574cc6 1549 PRIVATE = (TARG)
0eb335df
BF
1550 {
15516 TYPE = null ===> (5)
1552 (was list)
29e61fd9 1553 FLAGS = (UNKNOWN,KIDS,SLABBED,LASTSIB)
0eb335df
BF
1554 {
15554 TYPE = pushmark ===> 7
1556 FLAGS = (SCALAR,SLABBED)
1557 }
1558 {
15598 TYPE = null ===> (6)
1560 (was rv2cv)
29e61fd9 1561 FLAGS = (SCALAR,KIDS,SLABBED,LASTSIB)
ef0f35a3 1562 PRIVATE = (0x1)
0eb335df
BF
1563 {
15647 TYPE = gv ===> 5
29e61fd9 1565 FLAGS = (SCALAR,SLABBED,LASTSIB)
0eb335df
BF
1566 GV_OR_PADIX
1567 }
1568 }
1569 }
1570 }
1571}
1572EODUMP
1573
0eb335df 1574$e =~ s/GV_OR_PADIX/$threads ? "PADIX = 2" : "GV = t::DumpProg"/e;
ef0f35a3 1575$e =~ s/.*PRIVATE = \(0x1\).*\n// if $] < 5.021004;
0eb335df
BF
1576
1577test_DumpProg("package t;", $e, "DumpProg() has no 'Attempt to free X prematurely' warning", "is" );
1578
06a5cade 1579done_testing();