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