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