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