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