This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PVFMs don't need CvDEPTH, and PVCVs don't use SvIVX, so moving
[perl5.git] / ext / Devel / Peek / t / Peek.t
CommitLineData
99331854 1#!./perl -T
9ec58fb7
JH
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
9ec58fb7
JH
6 require Config; import Config;
7 if ($Config{'extensions'} !~ /\bPeek\b/) {
8 print "1..0 # Skip: Devel::Peek was not built\n";
9 exit 0;
10 }
11}
12
9248c45a
JH
13use Devel::Peek;
14
b1886099 15print "1..23\n";
9248c45a
JH
16
17our $DEBUG = 0;
277ddfaf 18open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
9248c45a 19
bf53b3a5 20
9248c45a
JH
21sub do_test {
22 my $pattern = pop;
277ddfaf
GS
23 if (open(OUT,">peek$$")) {
24 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
9248c45a 25 Dump($_[1]);
277ddfaf
GS
26 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
27 close(OUT);
9248c45a
JH
28 if (open(IN, "peek$$")) {
29 local $/;
30 $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
8aacddc1 31 $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
fd0854ff 32 # handle DEBUG_LEAKING_SCALARS prefix
d94a5950 33 $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
bf53b3a5 34
d04ba589
NC
35 $pattern =~ s/^ *\$XSUB *\n/
36 ($] < 5.009) ? " XSUB = 0\n XSUBANY = 0\n" : '';
bf53b3a5 37 /mge;
d04ba589
NC
38 $pattern =~ s/^ *\$ROOT *\n/
39 ($] < 5.009) ? " ROOT = 0x0\n" : '';
40 /mge;
41
bf53b3a5
NC
42
43
9248c45a
JH
44 print $pattern, "\n" if $DEBUG;
45 my $dump = <IN>;
46 print $dump, "\n" if $DEBUG;
dc3aa7ec
JH
47 print "got:\n[\n$dump\n]\nexpected:\n[\n$pattern\n]\nnot "
48 unless $dump =~ /\A$pattern\Z/ms;
9248c45a
JH
49 print "ok $_[0]\n";
50 close(IN);
59d8ce62 51 return $1;
9248c45a
JH
52 } else {
53 die "$0: failed to open peek$$: !\n";
54 }
55 } else {
56 die "$0: failed to create peek$$: $!\n";
57 }
58}
59
60our $a;
61our $b;
62my $c;
208edb77 63local $d = 0;
9248c45a 64
bf53b3a5 65
9248c45a
JH
66do_test( 1,
67 $a = "foo",
68'SV = PV\\($ADDR\\) at $ADDR
69 REFCNT = 1
70 FLAGS = \\(POK,pPOK\\)
71 PV = $ADDR "foo"\\\0
72 CUR = 3
1badabf5 73 LEN = \\d+'
9248c45a
JH
74 );
75
76do_test( 2,
77 "bar",
78'SV = PV\\($ADDR\\) at $ADDR
79 REFCNT = 1
7766e686 80 FLAGS = \\(.*POK,READONLY,pPOK\\)
9248c45a
JH
81 PV = $ADDR "bar"\\\0
82 CUR = 3
1badabf5 83 LEN = \\d+');
9248c45a
JH
84
85do_test( 3,
86 $b = 123,
87'SV = IV\\($ADDR\\) at $ADDR
88 REFCNT = 1
89 FLAGS = \\(IOK,pIOK\\)
90 IV = 123');
91
92do_test( 4,
93 456,
94'SV = IV\\($ADDR\\) at $ADDR
95 REFCNT = 1
7766e686 96 FLAGS = \\(.*IOK,READONLY,pIOK\\)
9248c45a
JH
97 IV = 456');
98
99do_test( 5,
100 $c = 456,
101'SV = IV\\($ADDR\\) at $ADDR
102 REFCNT = 1
235cc2e3 103 FLAGS = \\(PADMY,IOK,pIOK\\)
9248c45a
JH
104 IV = 456');
105
59d8ce62
NC
106# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
107# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
108# maths is done in floating point always, and this scalar will be an NV.
109# ([NI]) captures the type, referred to by \1 in this regexp and $type for
110# building subsequent regexps.
111my $type = do_test( 6,
9248c45a 112 $c + $d,
59d8ce62 113'SV = ([NI])V\\($ADDR\\) at $ADDR
9248c45a 114 REFCNT = 1
59d8ce62
NC
115 FLAGS = \\(PADTMP,\1OK,p\1OK\\)
116 \1V = 456');
9248c45a
JH
117
118($d = "789") += 0.1;
119
120do_test( 7,
121 $d,
122'SV = PVNV\\($ADDR\\) at $ADDR
123 REFCNT = 1
124 FLAGS = \\(NOK,pNOK\\)
125 IV = 0
ac634a9a 126 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
9248c45a
JH
127 PV = $ADDR "789"\\\0
128 CUR = 3
1badabf5 129 LEN = \\d+');
9248c45a
JH
130
131do_test( 8,
132 0xabcd,
133'SV = IV\\($ADDR\\) at $ADDR
134 REFCNT = 1
28e5dec8
JH
135 FLAGS = \\(.*IOK,READONLY,pIOK\\)
136 IV = 43981');
9248c45a
JH
137
138do_test( 9,
139 undef,
140'SV = NULL\\(0x0\\) at $ADDR
141 REFCNT = 1
142 FLAGS = \\(\\)');
143
144do_test(10,
145 \$a,
146'SV = RV\\($ADDR\\) at $ADDR
147 REFCNT = 1
148 FLAGS = \\(ROK\\)
149 RV = $ADDR
150 SV = PV\\($ADDR\\) at $ADDR
151 REFCNT = 2
152 FLAGS = \\(POK,pPOK\\)
153 PV = $ADDR "foo"\\\0
154 CUR = 3
1badabf5 155 LEN = \\d+');
9248c45a 156
59d8ce62
NC
157my $c_pattern;
158if ($type eq 'N') {
159 $c_pattern = '
160 SV = PVNV\\($ADDR\\) at $ADDR
161 REFCNT = 1
162 FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
163 IV = 456
164 NV = 456
165 PV = 0';
166} else {
167 $c_pattern = '
168 SV = IV\\($ADDR\\) at $ADDR
169 REFCNT = 1
170 FLAGS = \\(IOK,pIOK\\)
171 IV = 456';
172}
9248c45a
JH
173do_test(11,
174 [$b,$c],
175'SV = RV\\($ADDR\\) at $ADDR
176 REFCNT = 1
177 FLAGS = \\(ROK\\)
178 RV = $ADDR
179 SV = PVAV\\($ADDR\\) at $ADDR
180 REFCNT = 2
181 FLAGS = \\(\\)
9248c45a
JH
182 ARRAY = $ADDR
183 FILL = 1
184 MAX = 1
185 ARYLEN = 0x0
186 FLAGS = \\(REAL\\)
187 Elt No. 0
188 SV = IV\\($ADDR\\) at $ADDR
189 REFCNT = 1
190 FLAGS = \\(IOK,pIOK\\)
191 IV = 123
59d8ce62 192 Elt No. 1' . $c_pattern);
9248c45a
JH
193
194do_test(12,
195 {$b=>$c},
196'SV = RV\\($ADDR\\) at $ADDR
197 REFCNT = 1
198 FLAGS = \\(ROK\\)
199 RV = $ADDR
200 SV = PVHV\\($ADDR\\) at $ADDR
201 REFCNT = 2
202 FLAGS = \\(SHAREKEYS\\)
9248c45a 203 ARRAY = $ADDR \\(0:7, 1:1\\)
b8fa94d8 204 hash quality = 100.0%
9248c45a
JH
205 KEYS = 1
206 FILL = 1
207 MAX = 7
208 RITER = -1
209 EITER = 0x0
59d8ce62 210 Elt "123" HASH = $ADDR' . $c_pattern);
9248c45a
JH
211
212do_test(13,
213 sub(){@_},
214'SV = RV\\($ADDR\\) at $ADDR
215 REFCNT = 1
216 FLAGS = \\(ROK\\)
217 RV = $ADDR
218 SV = PVCV\\($ADDR\\) at $ADDR
219 REFCNT = 2
235cc2e3 220 FLAGS = \\(PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
9248c45a
JH
221 NV = 0
222 PROTOTYPE = ""
223 COMP_STASH = $ADDR\\t"main"
224 START = $ADDR ===> \\d+
225 ROOT = $ADDR
d04ba589 226 $XSUB
208edb77 227 GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
084d946d 228 FILE = ".*\\b(?i:peek\\.t)"
9248c45a 229 DEPTH = 0
9856a127 230(?: MUTEXP = $ADDR
208edb77 231 OWNER = $ADDR
5b4563c8 232)? FLAGS = 0x90
a3985cdc 233 OUTSIDE_SEQ = \\d+
9248c45a 234 PADLIST = $ADDR
dd2155a4 235 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
9248c45a
JH
236 OUTSIDE = $ADDR \\(MAIN\\)');
237
238do_test(14,
239 \&do_test,
240'SV = RV\\($ADDR\\) at $ADDR
241 REFCNT = 1
242 FLAGS = \\(ROK\\)
243 RV = $ADDR
244 SV = PVCV\\($ADDR\\) at $ADDR
9856a127 245 REFCNT = (3|4)
9248c45a 246 FLAGS = \\(\\)
9248c45a
JH
247 NV = 0
248 COMP_STASH = $ADDR\\t"main"
249 START = $ADDR ===> \\d+
250 ROOT = $ADDR
d04ba589 251 $XSUB
9248c45a 252 GVGV::GV = $ADDR\\t"main" :: "do_test"
084d946d 253 FILE = ".*\\b(?i:peek\\.t)"
9248c45a 254 DEPTH = 1
9856a127 255(?: MUTEXP = $ADDR
208edb77
MG
256 OWNER = $ADDR
257)? FLAGS = 0x0
a3985cdc 258 OUTSIDE_SEQ = \\d+
9248c45a 259 PADLIST = $ADDR
dd2155a4 260 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
ee6cee0c 261 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
b5c19bd7 262 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0
ee6cee0c 263 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
9248c45a
JH
264 OUTSIDE = $ADDR \\(MAIN\\)');
265
266do_test(15,
267 qr(tic),
268'SV = RV\\($ADDR\\) at $ADDR
269 REFCNT = 1
270 FLAGS = \\(ROK\\)
271 RV = $ADDR
272 SV = PVMG\\($ADDR\\) at $ADDR
273 REFCNT = 1
faf82a0b 274 FLAGS = \\(OBJECT,SMG\\)
9248c45a
JH
275 IV = 0
276 NV = 0
277 PV = 0
278 MAGIC = $ADDR
279 MG_VIRTUAL = $ADDR
14befaf4 280 MG_TYPE = PERL_MAGIC_qr\(r\)
9248c45a
JH
281 MG_OBJ = $ADDR
282 STASH = $ADDR\\t"Regexp"');
283
284do_test(16,
285 (bless {}, "Tac"),
286'SV = RV\\($ADDR\\) at $ADDR
287 REFCNT = 1
288 FLAGS = \\(ROK\\)
289 RV = $ADDR
290 SV = PVHV\\($ADDR\\) at $ADDR
291 REFCNT = 2
292 FLAGS = \\(OBJECT,SHAREKEYS\\)
9248c45a
JH
293 STASH = $ADDR\\t"Tac"
294 ARRAY = 0x0
295 KEYS = 0
296 FILL = 0
297 MAX = 7
298 RITER = -1
299 EITER = 0x0');
300
301do_test(17,
302 *a,
303'SV = PVGV\\($ADDR\\) at $ADDR
304 REFCNT = 5
b07ccbd7 305 FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
9248c45a
JH
306 IV = 0
307 NV = 0
308 MAGIC = $ADDR
309 MG_VIRTUAL = &PL_vtbl_glob
14befaf4 310 MG_TYPE = PERL_MAGIC_glob\(\*\)
9248c45a 311 MG_OBJ = $ADDR
9248c45a
JH
312 NAME = "a"
313 NAMELEN = 1
314 GvSTASH = $ADDR\\t"main"
315 GP = $ADDR
316 SV = $ADDR
317 REFCNT = 1
318 IO = 0x0
319 FORM = 0x0
320 AV = 0x0
321 HV = 0x0
322 CV = 0x0
323 CVGEN = 0x0
9ec58fb7 324 LINE = \\d+
084d946d 325 FILE = ".*\\b(?i:peek\\.t)"
e39917cc 326 FLAGS = $ADDR
9248c45a
JH
327 EGV = $ADDR\\t"a"');
328
cdb2dd7b
JH
329if (ord('A') == 193) {
330do_test(18,
331 chr(256).chr(0).chr(512),
332'SV = PV\\($ADDR\\) at $ADDR
333 REFCNT = 1
235cc2e3 334 FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
cdb2dd7b
JH
335 PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
336 CUR = 5
1badabf5 337 LEN = \\d+');
cdb2dd7b 338} else {
e6abe6d8
JH
339do_test(18,
340 chr(256).chr(0).chr(512),
341'SV = PV\\($ADDR\\) at $ADDR
342 REFCNT = 1
235cc2e3 343 FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
98c991d1 344 PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
e6abe6d8 345 CUR = 5
1badabf5 346 LEN = \\d+');
cdb2dd7b 347}
e6abe6d8 348
cdb2dd7b
JH
349if (ord('A') == 193) {
350do_test(19,
351 {chr(256)=>chr(512)},
352'SV = RV\\($ADDR\\) at $ADDR
353 REFCNT = 1
354 FLAGS = \\(ROK\\)
355 RV = $ADDR
356 SV = PVHV\\($ADDR\\) at $ADDR
357 REFCNT = 2
b2caaddd 358 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
cdb2dd7b
JH
359 ARRAY = $ADDR \\(0:7, 1:1\\)
360 hash quality = 100.0%
361 KEYS = 1
362 FILL = 1
363 MAX = 7
364 RITER = -1
365 EITER = $ADDR
6cbfa5b4 366 Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
cdb2dd7b
JH
367 SV = PV\\($ADDR\\) at $ADDR
368 REFCNT = 1
369 FLAGS = \\(POK,pPOK,UTF8\\)
370 PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
371 CUR = 2
1badabf5 372 LEN = \\d+');
cdb2dd7b 373} else {
98c991d1
JH
374do_test(19,
375 {chr(256)=>chr(512)},
376'SV = RV\\($ADDR\\) at $ADDR
377 REFCNT = 1
378 FLAGS = \\(ROK\\)
379 RV = $ADDR
380 SV = PVHV\\($ADDR\\) at $ADDR
381 REFCNT = 2
19692e8d 382 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
98c991d1
JH
383 ARRAY = $ADDR \\(0:7, 1:1\\)
384 hash quality = 100.0%
385 KEYS = 1
386 FILL = 1
387 MAX = 7
388 RITER = -1
389 EITER = $ADDR
390 Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
391 SV = PV\\($ADDR\\) at $ADDR
392 REFCNT = 1
393 FLAGS = \\(POK,pPOK,UTF8\\)
394 PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
395 CUR = 2
1badabf5 396 LEN = \\d+');
cdb2dd7b 397}
98c991d1 398
99331854
YST
399my $x="";
400$x=~/.??/g;
401do_test(20,
402 $x,
403'SV = PVMG\\($ADDR\\) at $ADDR
404 REFCNT = 1
235cc2e3 405 FLAGS = \\(PADMY,SMG,POK,pPOK\\)
99331854
YST
406 IV = 0
407 NV = 0
408 PV = $ADDR ""\\\0
409 CUR = 0
1936d2a7 410 LEN = \d+
99331854
YST
411 MAGIC = $ADDR
412 MG_VIRTUAL = &PL_vtbl_mglob
413 MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
414 MG_FLAGS = 0x01
415 MINMATCH');
416
f24fdb76
HS
417#
418# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
419# environment variables may be invisibly case-forced, hence the (?i:PATH)
5e836f43 420# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
d9baf692
JM
421# VMS is setting FAKE and READONLY flags. What VMS uses for storing
422# ENV hashes is also not always null terminated.
f24fdb76 423#
99331854
YST
424do_test(21,
425 $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
426'SV = PVMG\\($ADDR\\) at $ADDR
427 REFCNT = 1
428 FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
429 IV = 0
430 NV = 0
431 PV = $ADDR "0"\\\0
432 CUR = 1
433 LEN = \d+
434 MAGIC = $ADDR
435 MG_VIRTUAL = &PL_vtbl_envelem
436 MG_TYPE = PERL_MAGIC_envelem\\(e\\)
d25a523c 437(?: MG_FLAGS = 0x01
99331854 438 TAINTEDDIR
143a3e5e
CB
439)? MG_LEN = -?\d+
440 MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
5e836f43 441 SV = PV(?:IV)?\\($ADDR\\) at $ADDR
143a3e5e 442 REFCNT = \d+
11e2783c 443 FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
f0fabfd7 444(?: IV = 0
d9baf692 445)? PV = $ADDR "(?i:PATH)"(?:\\\0)?
143a3e5e
CB
446 CUR = \d+
447 LEN = \d+)
99331854
YST
448 MAGIC = $ADDR
449 MG_VIRTUAL = &PL_vtbl_taint
450 MG_TYPE = PERL_MAGIC_taint\\(t\\)');
451
9248c45a 452END {
92e5451f 453 1 while unlink("peek$$");
9248c45a 454}
6bf47b08
SR
455
456# blessed refs
457do_test(22,
458 bless(\\undef, 'Foobar'),
459'SV = RV\\($ADDR\\) at $ADDR
460 REFCNT = 1
461 FLAGS = \\(ROK\\)
462 RV = $ADDR
463 SV = PVMG\\($ADDR\\) at $ADDR
464 REFCNT = 2
465 FLAGS = \\(OBJECT,ROK\\)
7957ad98
MB
466 IV = -?\d+
467 NV = $FLOAT
6bf47b08
SR
468 RV = $ADDR
469 SV = NULL\\(0x0\\) at $ADDR
470 REFCNT = \d+
471 FLAGS = \\(READONLY\\)
472 PV = $ADDR ""
473 CUR = 0
474 LEN = 0
475 STASH = $ADDR\s+"Foobar"');
b1886099
NC
476
477# Constant subroutines
478
479sub const () {
480 "Perl rules";
481}
482
483do_test(23,
484 \&const,
485'SV = RV\\($ADDR\\) at $ADDR
486 REFCNT = 1
487 FLAGS = \\(ROK\\)
488 RV = $ADDR
489 SV = PVCV\\($ADDR\\) at $ADDR
490 REFCNT = (2)
491 FLAGS = \\(POK,pPOK,CONST\\)
b1886099
NC
492 NV = 0
493 PROTOTYPE = ""
494 COMP_STASH = 0x0
d04ba589 495 $ROOT
b1886099
NC
496 XSUB = $ADDR
497 XSUBANY = $ADDR \\(CONST SV\\)
498 SV = PV\\($ADDR\\) at $ADDR
499 REFCNT = 1
500 FLAGS = \\(.*POK,READONLY,pPOK\\)
501 PV = $ADDR "Perl rules"\\\0
502 CUR = 10
503 LEN = \\d+
504 GVGV::GV = $ADDR\\t"main" :: "const"
505 FILE = ".*\\b(?i:peek\\.t)"
506 DEPTH = 0
507(?: MUTEXP = $ADDR
508 OWNER = $ADDR
d04ba589 509)? FLAGS = 0x1400
b1886099
NC
510 OUTSIDE_SEQ = 0
511 PADLIST = 0x0
512 OUTSIDE = 0x0 \\(null\\)');