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