This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_do_sv_dump() shouldn't show "IV" for a FBM, as it's not valid.
[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 }
9}
10
06a5cade 11use Test::More;
e7ecf62c 12
9248c45a
JH
13use Devel::Peek;
14
9248c45a 15our $DEBUG = 0;
277ddfaf 16open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
9248c45a 17
bfe27a58
NC
18# If I reference any lexicals in this, I get the entire outer subroutine (or
19# MAIN) dumped too, which isn't really what I want, as it's a lot of faff to
20# maintain that.
21format PIE =
22Pie @<<<<<
23$::type
24Good @>>>>>
25$::mmmm
26.
27
9248c45a 28sub do_test {
000fd473
NC
29 my $todo = $_[3];
30 my $repeat_todo = $_[4];
31 my $pattern = $_[2];
277ddfaf
GS
32 if (open(OUT,">peek$$")) {
33 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
9248c45a 34 Dump($_[1]);
e9569a7a
GG
35 print STDERR "*****\n";
36 Dump($_[1]); # second dump to compare with the first to make sure nothing changed.
277ddfaf
GS
37 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
38 close(OUT);
9248c45a
JH
39 if (open(IN, "peek$$")) {
40 local $/;
41 $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
8aacddc1 42 $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
fd0854ff 43 # handle DEBUG_LEAKING_SCALARS prefix
d94a5950 44 $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
bf53b3a5 45
000fd473
NC
46 # Need some clear generic mechanism to eliminate (or add) lines
47 # of dump output dependant on perl version. The (previous) use of
48 # things like $IVNV gave the illusion that the string passed in was
49 # a regexp into which variables were interpolated, but this wasn't
50 # actually true as those 'variables' actually also ate the
b7b1e41b 51 # whitespace on the line. So it seems better to mark lines that
000fd473
NC
52 # need to be eliminated. I considered (?# ... ) and (?{ ... }),
53 # but whilst embedded code or comment syntax would keep it as a
54 # legitimate regexp, it still isn't true. Seems easier and clearer
55 # things that look like comments.
56
c2485e0c 57 my $version_condition = qr/\$] [<>]=? 5\.\d\d\d/;
000fd473
NC
58 # Could do this is in a s///mge but seems clearer like this:
59 $pattern = join '', map {
60 # If we identify the version condition, take *it* out whatever
c2485e0c 61 s/\s*# ($version_condition(?: && $version_condition)?)$//
000fd473
NC
62 ? (eval $1 ? $_ : '')
63 : $_ # Didn't match, so this line is in
64 } split /^/, $pattern;
65
66 $pattern =~ s/\$PADMY/
67 ($] < 5.009) ? 'PADBUSY,PADMY' : 'PADMY';
68 /mge;
69 $pattern =~ s/\$PADTMP/
70 ($] < 5.009) ? 'PADBUSY,PADTMP' : 'PADTMP';
71 /mge;
2b631c93
NC
72 $pattern =~ s/\$RV/
73 ($] < 5.011) ? 'RV' : 'IV';
74 /mge;
d04ba589 75
9248c45a 76 print $pattern, "\n" if $DEBUG;
e9569a7a 77 my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
9248c45a 78 print $dump, "\n" if $DEBUG;
06a5cade
NC
79 like( $dump, qr/\A$pattern\Z/ms, $_[0])
80 or note("line " . (caller)[2]);
e9569a7a 81
000fd473 82 local $TODO = $repeat_todo;
06a5cade
NC
83 is($dump2, $dump, "$_[0] (unchanged by dump)")
84 or note("line " . (caller)[2]);
e9569a7a 85
9248c45a 86 close(IN);
e9569a7a 87
59d8ce62 88 return $1;
9248c45a
JH
89 } else {
90 die "$0: failed to open peek$$: !\n";
91 }
92 } else {
93 die "$0: failed to create peek$$: $!\n";
94 }
95}
96
97our $a;
98our $b;
99my $c;
208edb77 100local $d = 0;
9248c45a 101
e7ecf62c
RGS
102END {
103 1 while unlink("peek$$");
104}
bf53b3a5 105
06a5cade 106do_test('assignment of immediate constant (string)',
9248c45a
JH
107 $a = "foo",
108'SV = PV\\($ADDR\\) at $ADDR
109 REFCNT = 1
110 FLAGS = \\(POK,pPOK\\)
111 PV = $ADDR "foo"\\\0
112 CUR = 3
1badabf5 113 LEN = \\d+'
9248c45a
JH
114 );
115
06a5cade 116do_test('immediate constant (string)',
9248c45a
JH
117 "bar",
118'SV = PV\\($ADDR\\) at $ADDR
119 REFCNT = 1
7766e686 120 FLAGS = \\(.*POK,READONLY,pPOK\\)
9248c45a
JH
121 PV = $ADDR "bar"\\\0
122 CUR = 3
1badabf5 123 LEN = \\d+');
9248c45a 124
b7b1e41b 125do_test('assignment of immediate constant (integer)',
9248c45a
JH
126 $b = 123,
127'SV = IV\\($ADDR\\) at $ADDR
128 REFCNT = 1
129 FLAGS = \\(IOK,pIOK\\)
130 IV = 123');
131
06a5cade 132do_test('immediate constant (integer)',
9248c45a
JH
133 456,
134'SV = IV\\($ADDR\\) at $ADDR
135 REFCNT = 1
7766e686 136 FLAGS = \\(.*IOK,READONLY,pIOK\\)
9248c45a
JH
137 IV = 456');
138
06a5cade 139do_test('assignment of immediate constant (integer)',
9248c45a
JH
140 $c = 456,
141'SV = IV\\($ADDR\\) at $ADDR
142 REFCNT = 1
000fd473 143 FLAGS = \\($PADMY,IOK,pIOK\\)
9248c45a
JH
144 IV = 456');
145
59d8ce62
NC
146# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
147# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
148# maths is done in floating point always, and this scalar will be an NV.
149# ([NI]) captures the type, referred to by \1 in this regexp and $type for
150# building subsequent regexps.
06a5cade 151my $type = do_test('result of addition',
9248c45a 152 $c + $d,
59d8ce62 153'SV = ([NI])V\\($ADDR\\) at $ADDR
9248c45a 154 REFCNT = 1
59d8ce62
NC
155 FLAGS = \\(PADTMP,\1OK,p\1OK\\)
156 \1V = 456');
9248c45a
JH
157
158($d = "789") += 0.1;
159
06a5cade 160do_test('floating point value',
9248c45a
JH
161 $d,
162'SV = PVNV\\($ADDR\\) at $ADDR
163 REFCNT = 1
164 FLAGS = \\(NOK,pNOK\\)
78d00c47 165 IV = \d+
ac634a9a 166 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
9248c45a
JH
167 PV = $ADDR "789"\\\0
168 CUR = 3
1badabf5 169 LEN = \\d+');
9248c45a 170
06a5cade 171do_test('integer constant',
9248c45a
JH
172 0xabcd,
173'SV = IV\\($ADDR\\) at $ADDR
174 REFCNT = 1
28e5dec8
JH
175 FLAGS = \\(.*IOK,READONLY,pIOK\\)
176 IV = 43981');
9248c45a 177
06a5cade 178do_test('undef',
9248c45a
JH
179 undef,
180'SV = NULL\\(0x0\\) at $ADDR
181 REFCNT = 1
182 FLAGS = \\(\\)');
183
06a5cade 184do_test('reference to scalar',
9248c45a 185 \$a,
4df7f6af 186'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
187 REFCNT = 1
188 FLAGS = \\(ROK\\)
189 RV = $ADDR
190 SV = PV\\($ADDR\\) at $ADDR
191 REFCNT = 2
192 FLAGS = \\(POK,pPOK\\)
193 PV = $ADDR "foo"\\\0
194 CUR = 3
1badabf5 195 LEN = \\d+');
9248c45a 196
59d8ce62
NC
197my $c_pattern;
198if ($type eq 'N') {
199 $c_pattern = '
200 SV = PVNV\\($ADDR\\) at $ADDR
201 REFCNT = 1
202 FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
203 IV = 456
204 NV = 456
205 PV = 0';
206} else {
207 $c_pattern = '
208 SV = IV\\($ADDR\\) at $ADDR
209 REFCNT = 1
210 FLAGS = \\(IOK,pIOK\\)
211 IV = 456';
212}
06a5cade 213do_test('reference to array',
9248c45a 214 [$b,$c],
4df7f6af 215'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
216 REFCNT = 1
217 FLAGS = \\(ROK\\)
218 RV = $ADDR
219 SV = PVAV\\($ADDR\\) at $ADDR
78c72037 220 REFCNT = 1
9248c45a 221 FLAGS = \\(\\)
1bcecb77
NC
222 IV = 0 # $] < 5.009
223 NV = 0 # $] < 5.009
9248c45a
JH
224 ARRAY = $ADDR
225 FILL = 1
226 MAX = 1
227 ARYLEN = 0x0
228 FLAGS = \\(REAL\\)
229 Elt No. 0
230 SV = IV\\($ADDR\\) at $ADDR
231 REFCNT = 1
232 FLAGS = \\(IOK,pIOK\\)
233 IV = 123
59d8ce62 234 Elt No. 1' . $c_pattern);
9248c45a 235
06a5cade 236do_test('reference to hash',
9248c45a 237 {$b=>$c},
4df7f6af 238'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
239 REFCNT = 1
240 FLAGS = \\(ROK\\)
241 RV = $ADDR
242 SV = PVHV\\($ADDR\\) at $ADDR
78c72037 243 REFCNT = 1
9248c45a 244 FLAGS = \\(SHAREKEYS\\)
1bcecb77
NC
245 IV = 1 # $] < 5.009
246 NV = $FLOAT # $] < 5.009
9248c45a 247 ARRAY = $ADDR \\(0:7, 1:1\\)
b8fa94d8 248 hash quality = 100.0%
9248c45a
JH
249 KEYS = 1
250 FILL = 1
251 MAX = 7
252 RITER = -1
253 EITER = 0x0
000fd473
NC
254 Elt "123" HASH = $ADDR' . $c_pattern,
255 '',
256 $] > 5.009 && 'The hash iterator used in dump.c sets the OOK flag');
9248c45a 257
06a5cade 258do_test('reference to anon sub with empty prototype',
9248c45a 259 sub(){@_},
4df7f6af 260'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
261 REFCNT = 1
262 FLAGS = \\(ROK\\)
263 RV = $ADDR
264 SV = PVCV\\($ADDR\\) at $ADDR
265 REFCNT = 2
cfc1e951 266 FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC\\)
1bcecb77
NC
267 IV = 0 # $] < 5.009
268 NV = 0 # $] < 5.009
9248c45a
JH
269 PROTOTYPE = ""
270 COMP_STASH = $ADDR\\t"main"
271 START = $ADDR ===> \\d+
272 ROOT = $ADDR
1bcecb77
NC
273 XSUB = 0x0 # $] < 5.009
274 XSUBANY = 0 # $] < 5.009
208edb77 275 GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
084d946d 276 FILE = ".*\\b(?i:peek\\.t)"
000fd473
NC
277 DEPTH = 0(?:
278 MUTEXP = $ADDR
279 OWNER = $ADDR)?
1bcecb77 280 FLAGS = 0x404 # $] < 5.009
cfc1e951 281 FLAGS = 0x490 # $] >= 5.009
a3985cdc 282 OUTSIDE_SEQ = \\d+
9248c45a 283 PADLIST = $ADDR
dd2155a4 284 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
9248c45a
JH
285 OUTSIDE = $ADDR \\(MAIN\\)');
286
06a5cade 287do_test('reference to named subroutine without prototype',
9248c45a 288 \&do_test,
4df7f6af 289'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
290 REFCNT = 1
291 FLAGS = \\(ROK\\)
292 RV = $ADDR
293 SV = PVCV\\($ADDR\\) at $ADDR
9856a127 294 REFCNT = (3|4)
9248c45a 295 FLAGS = \\(\\)
1bcecb77
NC
296 IV = 0 # $] < 5.009
297 NV = 0 # $] < 5.009
9248c45a
JH
298 COMP_STASH = $ADDR\\t"main"
299 START = $ADDR ===> \\d+
300 ROOT = $ADDR
1bcecb77
NC
301 XSUB = 0x0 # $] < 5.009
302 XSUBANY = 0 # $] < 5.009
9248c45a 303 GVGV::GV = $ADDR\\t"main" :: "do_test"
084d946d 304 FILE = ".*\\b(?i:peek\\.t)"
9248c45a 305 DEPTH = 1
9856a127 306(?: MUTEXP = $ADDR
208edb77
MG
307 OWNER = $ADDR
308)? FLAGS = 0x0
a3985cdc 309 OUTSIDE_SEQ = \\d+
9248c45a 310 PADLIST = $ADDR
dd2155a4 311 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
000fd473
NC
312 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$todo"
313 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$repeat_todo"
ee6cee0c 314 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
c2485e0c 315 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$version_condition"
000fd473
NC
316 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" # $] < 5.009
317 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 # $] >= 5.009
ee6cee0c 318 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
e9569a7a 319 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2"
9248c45a
JH
320 OUTSIDE = $ADDR \\(MAIN\\)');
321
3ce3ed55 322if ($] >= 5.011) {
06a5cade 323do_test('reference to regexp',
3ce3ed55
NC
324 qr(tic),
325'SV = $RV\\($ADDR\\) at $ADDR
326 REFCNT = 1
327 FLAGS = \\(ROK\\)
328 RV = $ADDR
5c35adbb 329 SV = REGEXP\\($ADDR\\) at $ADDR
c2123ae3 330 REFCNT = 1
b9ad13ac 331 FLAGS = \\(OBJECT,POK,FAKE,pPOK\\)
fb85c044
KW
332 PV = $ADDR "\\(\\?\\^:tic\\)"
333 CUR = 8
c2123ae3 334 LEN = 0
d63e6659
DM
335 STASH = $ADDR\\t"Regexp"'
336. ($] < 5.013 ? '' :
337'
338 EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
339 INTFLAGS = 0x0
340 NPARENS = 0
341 LASTPAREN = 0
342 LASTCLOSEPAREN = 0
343 MINLEN = 3
344 MINLENRET = 3
345 GOFS = 0
346 PRE_PREFIX = 4
347 SEEN_EVALS = 0
348 SUBLEN = 0
349 SUBBEG = 0x0
350 ENGINE = $ADDR
351 MOTHER_RE = $ADDR
352 PAREN_NAMES = 0x0
353 SUBSTRS = $ADDR
354 PPRIVATE = $ADDR
355 OFFS = $ADDR'
356));
3ce3ed55 357} else {
06a5cade 358do_test('reference to regexp',
9248c45a 359 qr(tic),
4df7f6af 360'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
361 REFCNT = 1
362 FLAGS = \\(ROK\\)
363 RV = $ADDR
364 SV = PVMG\\($ADDR\\) at $ADDR
365 REFCNT = 1
faf82a0b 366 FLAGS = \\(OBJECT,SMG\\)
9248c45a
JH
367 IV = 0
368 NV = 0
369 PV = 0
370 MAGIC = $ADDR
371 MG_VIRTUAL = $ADDR
14befaf4 372 MG_TYPE = PERL_MAGIC_qr\(r\)
9248c45a 373 MG_OBJ = $ADDR
fb85c044 374 PAT = "\(\?^:tic\)" # $] >= 5.009
1bcecb77 375 REFCNT = 2 # $] >= 5.009
9248c45a 376 STASH = $ADDR\\t"Regexp"');
3ce3ed55 377}
9248c45a 378
06a5cade 379do_test('reference to blessed hash',
9248c45a 380 (bless {}, "Tac"),
4df7f6af 381'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
382 REFCNT = 1
383 FLAGS = \\(ROK\\)
384 RV = $ADDR
385 SV = PVHV\\($ADDR\\) at $ADDR
78c72037 386 REFCNT = 1
9248c45a 387 FLAGS = \\(OBJECT,SHAREKEYS\\)
1bcecb77
NC
388 IV = 0 # $] < 5.009
389 NV = 0 # $] < 5.009
9248c45a
JH
390 STASH = $ADDR\\t"Tac"
391 ARRAY = 0x0
392 KEYS = 0
393 FILL = 0
394 MAX = 7
395 RITER = -1
000fd473
NC
396 EITER = 0x0', '',
397 $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
398 : "Something causes the HV's array to become allocated");
9248c45a 399
06a5cade 400do_test('typeglob',
9248c45a
JH
401 *a,
402'SV = PVGV\\($ADDR\\) at $ADDR
403 REFCNT = 5
000fd473
NC
404 FLAGS = \\(MULTI(?:,IN_PAD)?\\) # $] >= 5.009
405 FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\) # $] < 5.009
406 IV = 0 # $] < 5.009
407 NV = 0 # $] < 5.009
408 PV = 0 # $] < 5.009
409 MAGIC = $ADDR # $] < 5.009
410 MG_VIRTUAL = &PL_vtbl_glob # $] < 5.009
411 MG_TYPE = PERL_MAGIC_glob\(\*\) # $] < 5.009
412 MG_OBJ = $ADDR # $] < 5.009
9248c45a
JH
413 NAME = "a"
414 NAMELEN = 1
415 GvSTASH = $ADDR\\t"main"
416 GP = $ADDR
417 SV = $ADDR
418 REFCNT = 1
419 IO = 0x0
420 FORM = 0x0
421 AV = 0x0
422 HV = 0x0
423 CV = 0x0
424 CVGEN = 0x0
000fd473 425 GPFLAGS = 0x0 # $] < 5.009
9ec58fb7 426 LINE = \\d+
084d946d 427 FILE = ".*\\b(?i:peek\\.t)"
e39917cc 428 FLAGS = $ADDR
9248c45a
JH
429 EGV = $ADDR\\t"a"');
430
cdb2dd7b 431if (ord('A') == 193) {
06a5cade 432do_test('string with Unicode',
cdb2dd7b
JH
433 chr(256).chr(0).chr(512),
434'SV = PV\\($ADDR\\) at $ADDR
435 REFCNT = 1
000fd473 436 FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)
cdb2dd7b
JH
437 PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
438 CUR = 5
1badabf5 439 LEN = \\d+');
cdb2dd7b 440} else {
06a5cade 441do_test('string with Unicode',
e6abe6d8
JH
442 chr(256).chr(0).chr(512),
443'SV = PV\\($ADDR\\) at $ADDR
444 REFCNT = 1
000fd473 445 FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)
98c991d1 446 PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
e6abe6d8 447 CUR = 5
1badabf5 448 LEN = \\d+');
cdb2dd7b 449}
e6abe6d8 450
cdb2dd7b 451if (ord('A') == 193) {
06a5cade 452do_test('reference to hash containing Unicode',
cdb2dd7b 453 {chr(256)=>chr(512)},
4df7f6af 454'SV = $RV\\($ADDR\\) at $ADDR
cdb2dd7b
JH
455 REFCNT = 1
456 FLAGS = \\(ROK\\)
457 RV = $ADDR
458 SV = PVHV\\($ADDR\\) at $ADDR
78c72037 459 REFCNT = 1
b2caaddd 460 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1bcecb77
NC
461 UV = 1 # $] < 5.009
462 NV = $FLOAT # $] < 5.009
cdb2dd7b
JH
463 ARRAY = $ADDR \\(0:7, 1:1\\)
464 hash quality = 100.0%
465 KEYS = 1
466 FILL = 1
467 MAX = 7
468 RITER = -1
469 EITER = $ADDR
6cbfa5b4 470 Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
cdb2dd7b
JH
471 SV = PV\\($ADDR\\) at $ADDR
472 REFCNT = 1
473 FLAGS = \\(POK,pPOK,UTF8\\)
474 PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
475 CUR = 2
000fd473
NC
476 LEN = \\d+',
477 $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
478 : 'sv_length has been called on the element, and cached the result in MAGIC');
cdb2dd7b 479} else {
06a5cade 480do_test('reference to hash containing Unicode',
98c991d1 481 {chr(256)=>chr(512)},
4df7f6af 482'SV = $RV\\($ADDR\\) at $ADDR
98c991d1
JH
483 REFCNT = 1
484 FLAGS = \\(ROK\\)
485 RV = $ADDR
486 SV = PVHV\\($ADDR\\) at $ADDR
78c72037 487 REFCNT = 1
19692e8d 488 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1bcecb77
NC
489 UV = 1 # $] < 5.009
490 NV = 0 # $] < 5.009
98c991d1
JH
491 ARRAY = $ADDR \\(0:7, 1:1\\)
492 hash quality = 100.0%
493 KEYS = 1
494 FILL = 1
495 MAX = 7
496 RITER = -1
497 EITER = $ADDR
498 Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
499 SV = PV\\($ADDR\\) at $ADDR
500 REFCNT = 1
501 FLAGS = \\(POK,pPOK,UTF8\\)
502 PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
503 CUR = 2
000fd473
NC
504 LEN = \\d+', '',
505 $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
506 : 'sv_length has been called on the element, and cached the result in MAGIC');
cdb2dd7b 507}
98c991d1 508
99331854
YST
509my $x="";
510$x=~/.??/g;
06a5cade 511do_test('scalar with pos magic',
99331854
YST
512 $x,
513'SV = PVMG\\($ADDR\\) at $ADDR
514 REFCNT = 1
000fd473 515 FLAGS = \\($PADMY,SMG,POK,pPOK\\)
99331854
YST
516 IV = 0
517 NV = 0
518 PV = $ADDR ""\\\0
519 CUR = 0
1936d2a7 520 LEN = \d+
99331854
YST
521 MAGIC = $ADDR
522 MG_VIRTUAL = &PL_vtbl_mglob
523 MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
524 MG_FLAGS = 0x01
525 MINMATCH');
526
f24fdb76
HS
527#
528# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
529# environment variables may be invisibly case-forced, hence the (?i:PATH)
5e836f43 530# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
d9baf692
JM
531# VMS is setting FAKE and READONLY flags. What VMS uses for storing
532# ENV hashes is also not always null terminated.
f24fdb76 533#
06a5cade 534do_test('tainted value in %ENV',
99331854
YST
535 $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
536'SV = PVMG\\($ADDR\\) at $ADDR
537 REFCNT = 1
538 FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
539 IV = 0
540 NV = 0
541 PV = $ADDR "0"\\\0
542 CUR = 1
543 LEN = \d+
544 MAGIC = $ADDR
545 MG_VIRTUAL = &PL_vtbl_envelem
546 MG_TYPE = PERL_MAGIC_envelem\\(e\\)
d25a523c 547(?: MG_FLAGS = 0x01
99331854 548 TAINTEDDIR
143a3e5e
CB
549)? MG_LEN = -?\d+
550 MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
5e836f43 551 SV = PV(?:IV)?\\($ADDR\\) at $ADDR
143a3e5e 552 REFCNT = \d+
11e2783c 553 FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
f0fabfd7 554(?: IV = 0
d9baf692 555)? PV = $ADDR "(?i:PATH)"(?:\\\0)?
143a3e5e
CB
556 CUR = \d+
557 LEN = \d+)
99331854
YST
558 MAGIC = $ADDR
559 MG_VIRTUAL = &PL_vtbl_taint
560 MG_TYPE = PERL_MAGIC_taint\\(t\\)');
561
06a5cade 562do_test('blessed reference',
6bf47b08 563 bless(\\undef, 'Foobar'),
4df7f6af 564'SV = $RV\\($ADDR\\) at $ADDR
6bf47b08
SR
565 REFCNT = 1
566 FLAGS = \\(ROK\\)
567 RV = $ADDR
568 SV = PVMG\\($ADDR\\) at $ADDR
569 REFCNT = 2
570 FLAGS = \\(OBJECT,ROK\\)
7957ad98
MB
571 IV = -?\d+
572 NV = $FLOAT
6bf47b08
SR
573 RV = $ADDR
574 SV = NULL\\(0x0\\) at $ADDR
575 REFCNT = \d+
576 FLAGS = \\(READONLY\\)
577 PV = $ADDR ""
578 CUR = 0
579 LEN = 0
580 STASH = $ADDR\s+"Foobar"');
b1886099 581
b1886099
NC
582sub const () {
583 "Perl rules";
584}
585
06a5cade 586do_test('constant subroutine',
b1886099 587 \&const,
4df7f6af 588'SV = $RV\\($ADDR\\) at $ADDR
b1886099
NC
589 REFCNT = 1
590 FLAGS = \\(ROK\\)
591 RV = $ADDR
592 SV = PVCV\\($ADDR\\) at $ADDR
593 REFCNT = (2)
31d45e0c 594 FLAGS = \\(POK,pPOK,CONST,ISXSUB\\)
1bcecb77
NC
595 IV = 0 # $] < 5.009
596 NV = 0 # $] < 5.009
b1886099
NC
597 PROTOTYPE = ""
598 COMP_STASH = 0x0
1bcecb77 599 ROOT = 0x0 # $] < 5.009
b1886099
NC
600 XSUB = $ADDR
601 XSUBANY = $ADDR \\(CONST SV\\)
602 SV = PV\\($ADDR\\) at $ADDR
603 REFCNT = 1
604 FLAGS = \\(.*POK,READONLY,pPOK\\)
605 PV = $ADDR "Perl rules"\\\0
606 CUR = 10
607 LEN = \\d+
608 GVGV::GV = $ADDR\\t"main" :: "const"
609 FILE = ".*\\b(?i:peek\\.t)"
000fd473
NC
610 DEPTH = 0(?:
611 MUTEXP = $ADDR
612 OWNER = $ADDR)?
1bcecb77 613 FLAGS = 0x200 # $] < 5.009
c2485e0c
NC
614 FLAGS = 0xc00 # $] >= 5.009 && $] < 5.013
615 FLAGS = 0xc # $] >= 5.013
b1886099
NC
616 OUTSIDE_SEQ = 0
617 PADLIST = 0x0
618 OUTSIDE = 0x0 \\(null\\)');
2e94196c 619
06a5cade 620do_test('isUV should show on PVMG',
2e94196c
NC
621 do { my $v = $1; $v = ~0; $v },
622'SV = PVMG\\($ADDR\\) at $ADDR
623 REFCNT = 1
624 FLAGS = \\(IOK,pIOK,IsUV\\)
625 UV = \d+
626 NV = 0
627 PV = 0');
c0a413d1 628
06a5cade 629do_test('IO',
c0a413d1
NC
630 *STDOUT{IO},
631'SV = $RV\\($ADDR\\) at $ADDR
632 REFCNT = 1
633 FLAGS = \\(ROK\\)
634 RV = $ADDR
635 SV = PVIO\\($ADDR\\) at $ADDR
636 REFCNT = 3
637 FLAGS = \\(OBJECT\\)
3cf51070 638 IV = 0 # $] < 5.011
1bcecb77 639 NV = 0 # $] < 5.011
d963bf01 640 STASH = $ADDR\s+"IO::File"
c0a413d1
NC
641 IFP = $ADDR
642 OFP = $ADDR
643 DIRP = 0x0
644 LINES = 0
645 PAGE = 0
646 PAGE_LEN = 60
647 LINES_LEFT = 0
648 TOP_GV = 0x0
649 FMT_GV = 0x0
650 BOTTOM_GV = 0x0
1bcecb77 651 SUBPROCESS = 0 # $] < 5.009
c0a413d1 652 TYPE = \'>\'
50a9fad1 653 FLAGS = 0x4');
bfe27a58 654
06a5cade 655do_test('FORMAT',
bfe27a58
NC
656 *PIE{FORMAT},
657'SV = $RV\\($ADDR\\) at $ADDR
658 REFCNT = 1
659 FLAGS = \\(ROK\\)
660 RV = $ADDR
661 SV = PVFM\\($ADDR\\) at $ADDR
662 REFCNT = 2
663 FLAGS = \\(\\)
30ec677d 664 IV = 0 # $] < 5.009
bfe27a58 665 NV = 0 # $] < 5.009
251a4af1
DM
666(?: PV = 0
667)? COMP_STASH = 0x0
bfe27a58
NC
668 START = $ADDR ===> \\d+
669 ROOT = $ADDR
670 XSUB = 0x0 # $] < 5.009
671 XSUBANY = 0 # $] < 5.009
672 GVGV::GV = $ADDR\\t"main" :: "PIE"
673 FILE = ".*\\b(?i:peek\\.t)"
c12100a4
DM
674(?: DEPTH = 0
675 MUTEXP = $ADDR
bfe27a58
NC
676 OWNER = $ADDR
677)? FLAGS = 0x0
678 OUTSIDE_SEQ = \\d+
679 LINES = 0
680 PADLIST = $ADDR
681 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
682 OUTSIDE = $ADDR \\(MAIN\\)');
d7d51f4b 683
b7b1e41b 684do_test('blessing to a class with embedded NUL characters',
d7d51f4b
YO
685 (bless {}, "\0::foo::\n::baz::\t::\0"),
686'SV = $RV\\($ADDR\\) at $ADDR
687 REFCNT = 1
688 FLAGS = \\(ROK\\)
689 RV = $ADDR
690 SV = PVHV\\($ADDR\\) at $ADDR
691 REFCNT = 1
692 FLAGS = \\(OBJECT,SHAREKEYS\\)
693 IV = 0 # $] < 5.009
694 NV = 0 # $] < 5.009
695 STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0"
696 ARRAY = $ADDR
697 KEYS = 0
698 FILL = 0
699 MAX = 7
700 RITER = -1
701 EITER = 0x0', '',
702 $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
703 : "Something causes the HV's array to become allocated");
704
bed53064
NC
705do_test('ENAME on a stash',
706 \%RWOM::,
707'SV = $RV\\($ADDR\\) at $ADDR
708 REFCNT = 1
709 FLAGS = \\(ROK\\)
710 RV = $ADDR
711 SV = PVHV\\($ADDR\\) at $ADDR
712 REFCNT = 2
713 FLAGS = \\(OOK,SHAREKEYS\\)
714 IV = 1 # $] < 5.009
715 NV = $FLOAT # $] < 5.009
716 ARRAY = $ADDR
717 KEYS = 0
718 FILL = 0
719 MAX = 7
720 RITER = -1
721 EITER = 0x0
722 NAME = "RWOM"
723 ENAME = "RWOM" # $] > 5.012
724');
725
726*KLANK:: = \%RWOM::;
727
728do_test('ENAMEs on a stash',
729 \%RWOM::,
730'SV = $RV\\($ADDR\\) at $ADDR
731 REFCNT = 1
732 FLAGS = \\(ROK\\)
733 RV = $ADDR
734 SV = PVHV\\($ADDR\\) at $ADDR
735 REFCNT = 3
736 FLAGS = \\(OOK,SHAREKEYS\\)
737 IV = 1 # $] < 5.009
738 NV = $FLOAT # $] < 5.009
739 ARRAY = $ADDR
740 KEYS = 0
741 FILL = 0
742 MAX = 7
743 RITER = -1
744 EITER = 0x0
745 NAME = "RWOM"
746 NAMECOUNT = 2 # $] > 5.012
747 ENAME = "RWOM", "KLANK" # $] > 5.012
748');
749
750undef %RWOM::;
751
752do_test('ENAMEs on a stash with no NAME',
753 \%RWOM::,
754'SV = $RV\\($ADDR\\) at $ADDR
755 REFCNT = 1
756 FLAGS = \\(ROK\\)
757 RV = $ADDR
758 SV = PVHV\\($ADDR\\) at $ADDR
759 REFCNT = 3
760 FLAGS = \\(OOK,SHAREKEYS\\)
761 IV = 1 # $] < 5.009
762 NV = $FLOAT # $] < 5.009
763 ARRAY = $ADDR
764 KEYS = 0
765 FILL = 0
766 MAX = 7
767 RITER = -1
768 EITER = 0x0
769 NAMECOUNT = -3 # $] > 5.012
770 ENAME = "RWOM", "KLANK" # $] > 5.012
771');
772
4ab5bd5f
FC
773SKIP: {
774 skip "Not built with usemymalloc", 1
775 unless $Config{usemymalloc} eq 'y';
776 my $x = __PACKAGE__;
777 ok eval { fill_mstats($x); 1 }, 'fill_mstats on COW scalar'
778 or diag $@;
779}
780
0a0c4b76
NC
781use constant perl => 'rules';
782
783unless ($Config{useithreads}) {
784 # These end up as copies in pads under ithreads, which rather defeats the
785 # the point of what we're trying to test here.
786
787 do_test('regular string constant', perl,
788'SV = PV\\($ADDR\\) at $ADDR
789 REFCNT = 3
790 FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
791 PV = $ADDR "rules"\\\0
792 CUR = 5
793 LEN = \d+
794');
795
796 eval 'index "", perl';
797
798 # FIXME - really this shouldn't say EVALED. It's a false posistive on
799 # 0x40000000 being used for several things, not a flag for "I'm in a string
800 # eval"
801
802 do_test('string constant now an FBM', perl,
803'SV = PVGV\\($ADDR\\) at $ADDR
804 REFCNT = 3
805 FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
806 PV = $ADDR "rules"\\\0
807 CUR = 5
808 LEN = \d+
809 MAGIC = $ADDR
810 MG_VIRTUAL = &PL_vtbl_bm
811 MG_TYPE = PERL_MAGIC_bm\\(B\\)
812 FLAGS = 0
813 RARE = \d+
814 PREVIOUS = 1
815 USEFUL = 100
816');
817}
818
06a5cade 819done_testing();