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