Commit | Line | Data |
99331854 |
1 | #!./perl -T |
9ec58fb7 |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
9ec58fb7 |
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 |
13 | use Devel::Peek; |
14 | |
6bf47b08 |
15 | print "1..22\n"; |
9248c45a |
16 | |
17 | our $DEBUG = 0; |
277ddfaf |
18 | open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!"; |
9248c45a |
19 | |
20 | sub do_test { |
21 | my $pattern = pop; |
277ddfaf |
22 | if (open(OUT,">peek$$")) { |
23 | open(STDERR, ">&OUT") or die "Can't dup OUT: $!"; |
9248c45a |
24 | Dump($_[1]); |
277ddfaf |
25 | open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!"; |
26 | close(OUT); |
9248c45a |
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 |
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 |
35 | print "ok $_[0]\n"; |
36 | close(IN); |
59d8ce62 |
37 | return $1; |
9248c45a |
38 | } else { |
39 | die "$0: failed to open peek$$: !\n"; |
40 | } |
41 | } else { |
42 | die "$0: failed to create peek$$: $!\n"; |
43 | } |
44 | } |
45 | |
46 | our $a; |
47 | our $b; |
48 | my $c; |
208edb77 |
49 | local $d = 0; |
9248c45a |
50 | |
51 | do_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 |
59 | ); |
60 | |
61 | do_test( 2, |
62 | "bar", |
63 | 'SV = PV\\($ADDR\\) at $ADDR |
64 | REFCNT = 1 |
7766e686 |
65 | FLAGS = \\(.*POK,READONLY,pPOK\\) |
9248c45a |
66 | PV = $ADDR "bar"\\\0 |
67 | CUR = 3 |
1badabf5 |
68 | LEN = \\d+'); |
9248c45a |
69 | |
70 | do_test( 3, |
71 | $b = 123, |
72 | 'SV = IV\\($ADDR\\) at $ADDR |
73 | REFCNT = 1 |
74 | FLAGS = \\(IOK,pIOK\\) |
75 | IV = 123'); |
76 | |
77 | do_test( 4, |
78 | 456, |
79 | 'SV = IV\\($ADDR\\) at $ADDR |
80 | REFCNT = 1 |
7766e686 |
81 | FLAGS = \\(.*IOK,READONLY,pIOK\\) |
9248c45a |
82 | IV = 456'); |
83 | |
84 | do_test( 5, |
85 | $c = 456, |
86 | 'SV = IV\\($ADDR\\) at $ADDR |
87 | REFCNT = 1 |
88 | FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\) |
89 | IV = 456'); |
90 | |
59d8ce62 |
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. |
96 | my $type = do_test( 6, |
9248c45a |
97 | $c + $d, |
59d8ce62 |
98 | 'SV = ([NI])V\\($ADDR\\) at $ADDR |
9248c45a |
99 | REFCNT = 1 |
59d8ce62 |
100 | FLAGS = \\(PADTMP,\1OK,p\1OK\\) |
101 | \1V = 456'); |
9248c45a |
102 | |
103 | ($d = "789") += 0.1; |
104 | |
105 | do_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 |
112 | PV = $ADDR "789"\\\0 |
113 | CUR = 3 |
1badabf5 |
114 | LEN = \\d+'); |
9248c45a |
115 | |
116 | do_test( 8, |
117 | 0xabcd, |
118 | 'SV = IV\\($ADDR\\) at $ADDR |
119 | REFCNT = 1 |
28e5dec8 |
120 | FLAGS = \\(.*IOK,READONLY,pIOK\\) |
121 | IV = 43981'); |
9248c45a |
122 | |
123 | do_test( 9, |
124 | undef, |
125 | 'SV = NULL\\(0x0\\) at $ADDR |
126 | REFCNT = 1 |
127 | FLAGS = \\(\\)'); |
128 | |
129 | do_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 |
142 | my $c_pattern; |
143 | if ($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 |
158 | do_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 |
180 | |
181 | do_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 |
194 | KEYS = 1 |
195 | FILL = 1 |
196 | MAX = 7 |
197 | RITER = -1 |
198 | EITER = 0x0 |
59d8ce62 |
199 | Elt "123" HASH = $ADDR' . $c_pattern); |
9248c45a |
200 | |
201 | do_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 |
209 | FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\) |
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 |
223 | )? FLAGS = 0x4 |
9248c45a |
224 | PADLIST = $ADDR |
dd2155a4 |
225 | PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) |
9248c45a |
226 | OUTSIDE = $ADDR \\(MAIN\\)'); |
227 | |
228 | do_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 |
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 |
248 | OWNER = $ADDR |
249 | )? FLAGS = 0x0 |
9248c45a |
250 | PADLIST = $ADDR |
dd2155a4 |
251 | PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) |
252 | \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern" |
253 | \\d+\\. $ADDR<\\d+> FAKE \\(\\d+,\\d+\\) "\\$DEBUG" |
254 | \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump" |
9248c45a |
255 | OUTSIDE = $ADDR \\(MAIN\\)'); |
256 | |
257 | do_test(15, |
258 | qr(tic), |
259 | 'SV = RV\\($ADDR\\) at $ADDR |
260 | REFCNT = 1 |
261 | FLAGS = \\(ROK\\) |
262 | RV = $ADDR |
263 | SV = PVMG\\($ADDR\\) at $ADDR |
264 | REFCNT = 1 |
265 | FLAGS = \\(OBJECT,RMG\\) |
266 | IV = 0 |
267 | NV = 0 |
268 | PV = 0 |
269 | MAGIC = $ADDR |
270 | MG_VIRTUAL = $ADDR |
14befaf4 |
271 | MG_TYPE = PERL_MAGIC_qr\(r\) |
9248c45a |
272 | MG_OBJ = $ADDR |
273 | STASH = $ADDR\\t"Regexp"'); |
274 | |
275 | do_test(16, |
276 | (bless {}, "Tac"), |
277 | 'SV = RV\\($ADDR\\) at $ADDR |
278 | REFCNT = 1 |
279 | FLAGS = \\(ROK\\) |
280 | RV = $ADDR |
281 | SV = PVHV\\($ADDR\\) at $ADDR |
282 | REFCNT = 2 |
283 | FLAGS = \\(OBJECT,SHAREKEYS\\) |
284 | IV = 0 |
285 | NV = 0 |
286 | STASH = $ADDR\\t"Tac" |
287 | ARRAY = 0x0 |
288 | KEYS = 0 |
289 | FILL = 0 |
290 | MAX = 7 |
291 | RITER = -1 |
292 | EITER = 0x0'); |
293 | |
294 | do_test(17, |
295 | *a, |
296 | 'SV = PVGV\\($ADDR\\) at $ADDR |
297 | REFCNT = 5 |
b07ccbd7 |
298 | FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\) |
9248c45a |
299 | IV = 0 |
300 | NV = 0 |
301 | MAGIC = $ADDR |
302 | MG_VIRTUAL = &PL_vtbl_glob |
14befaf4 |
303 | MG_TYPE = PERL_MAGIC_glob\(\*\) |
9248c45a |
304 | MG_OBJ = $ADDR |
9248c45a |
305 | NAME = "a" |
306 | NAMELEN = 1 |
307 | GvSTASH = $ADDR\\t"main" |
308 | GP = $ADDR |
309 | SV = $ADDR |
310 | REFCNT = 1 |
311 | IO = 0x0 |
312 | FORM = 0x0 |
313 | AV = 0x0 |
314 | HV = 0x0 |
315 | CV = 0x0 |
316 | CVGEN = 0x0 |
317 | GPFLAGS = 0x0 |
9ec58fb7 |
318 | LINE = \\d+ |
084d946d |
319 | FILE = ".*\\b(?i:peek\\.t)" |
e39917cc |
320 | FLAGS = $ADDR |
9248c45a |
321 | EGV = $ADDR\\t"a"'); |
322 | |
cdb2dd7b |
323 | if (ord('A') == 193) { |
324 | do_test(18, |
325 | chr(256).chr(0).chr(512), |
326 | 'SV = PV\\($ADDR\\) at $ADDR |
327 | REFCNT = 1 |
328 | FLAGS = \\((?:PADBUSY,PADTMP,)?POK,READONLY,pPOK,UTF8\\) |
329 | PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\] |
330 | CUR = 5 |
1badabf5 |
331 | LEN = \\d+'); |
cdb2dd7b |
332 | } else { |
e6abe6d8 |
333 | do_test(18, |
334 | chr(256).chr(0).chr(512), |
335 | 'SV = PV\\($ADDR\\) at $ADDR |
336 | REFCNT = 1 |
898eb500 |
337 | FLAGS = \\((?:PADBUSY,PADTMP,)?POK,READONLY,pPOK,UTF8\\) |
98c991d1 |
338 | PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\] |
e6abe6d8 |
339 | CUR = 5 |
1badabf5 |
340 | LEN = \\d+'); |
cdb2dd7b |
341 | } |
e6abe6d8 |
342 | |
cdb2dd7b |
343 | if (ord('A') == 193) { |
344 | do_test(19, |
345 | {chr(256)=>chr(512)}, |
346 | 'SV = RV\\($ADDR\\) at $ADDR |
347 | REFCNT = 1 |
348 | FLAGS = \\(ROK\\) |
349 | RV = $ADDR |
350 | SV = PVHV\\($ADDR\\) at $ADDR |
351 | REFCNT = 2 |
b2caaddd |
352 | FLAGS = \\(SHAREKEYS,HASKFLAGS\\) |
574c8022 |
353 | UV = 1 |
8aacddc1 |
354 | NV = $FLOAT |
cdb2dd7b |
355 | ARRAY = $ADDR \\(0:7, 1:1\\) |
356 | hash quality = 100.0% |
357 | KEYS = 1 |
358 | FILL = 1 |
359 | MAX = 7 |
360 | RITER = -1 |
361 | EITER = $ADDR |
6cbfa5b4 |
362 | Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR |
cdb2dd7b |
363 | SV = PV\\($ADDR\\) at $ADDR |
364 | REFCNT = 1 |
365 | FLAGS = \\(POK,pPOK,UTF8\\) |
366 | PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\] |
367 | CUR = 2 |
1badabf5 |
368 | LEN = \\d+'); |
cdb2dd7b |
369 | } else { |
98c991d1 |
370 | do_test(19, |
371 | {chr(256)=>chr(512)}, |
372 | 'SV = RV\\($ADDR\\) at $ADDR |
373 | REFCNT = 1 |
374 | FLAGS = \\(ROK\\) |
375 | RV = $ADDR |
376 | SV = PVHV\\($ADDR\\) at $ADDR |
377 | REFCNT = 2 |
19692e8d |
378 | FLAGS = \\(SHAREKEYS,HASKFLAGS\\) |
574c8022 |
379 | UV = 1 |
98c991d1 |
380 | NV = 0 |
381 | ARRAY = $ADDR \\(0:7, 1:1\\) |
382 | hash quality = 100.0% |
383 | KEYS = 1 |
384 | FILL = 1 |
385 | MAX = 7 |
386 | RITER = -1 |
387 | EITER = $ADDR |
388 | Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR |
389 | SV = PV\\($ADDR\\) at $ADDR |
390 | REFCNT = 1 |
391 | FLAGS = \\(POK,pPOK,UTF8\\) |
392 | PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\] |
393 | CUR = 2 |
1badabf5 |
394 | LEN = \\d+'); |
cdb2dd7b |
395 | } |
98c991d1 |
396 | |
99331854 |
397 | my $x=""; |
398 | $x=~/.??/g; |
399 | do_test(20, |
400 | $x, |
401 | 'SV = PVMG\\($ADDR\\) at $ADDR |
402 | REFCNT = 1 |
403 | FLAGS = \\(PADBUSY,PADMY,SMG,POK,pPOK\\) |
404 | IV = 0 |
405 | NV = 0 |
406 | PV = $ADDR ""\\\0 |
407 | CUR = 0 |
408 | LEN = 1 |
409 | MAGIC = $ADDR |
410 | MG_VIRTUAL = &PL_vtbl_mglob |
411 | MG_TYPE = PERL_MAGIC_regex_global\\(g\\) |
412 | MG_FLAGS = 0x01 |
413 | MINMATCH'); |
414 | |
f24fdb76 |
415 | # |
416 | # TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS |
417 | # environment variables may be invisibly case-forced, hence the (?i:PATH) |
418 | # |
99331854 |
419 | do_test(21, |
420 | $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value |
421 | 'SV = PVMG\\($ADDR\\) at $ADDR |
422 | REFCNT = 1 |
423 | FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\) |
424 | IV = 0 |
425 | NV = 0 |
426 | PV = $ADDR "0"\\\0 |
427 | CUR = 1 |
428 | LEN = \d+ |
429 | MAGIC = $ADDR |
430 | MG_VIRTUAL = &PL_vtbl_envelem |
431 | MG_TYPE = PERL_MAGIC_envelem\\(e\\) |
d25a523c |
432 | (?: MG_FLAGS = 0x01 |
99331854 |
433 | TAINTEDDIR |
d25a523c |
434 | )? MG_LEN = 4 |
f24fdb76 |
435 | MG_PTR = $ADDR "(?i:PATH)" |
99331854 |
436 | MAGIC = $ADDR |
437 | MG_VIRTUAL = &PL_vtbl_taint |
438 | MG_TYPE = PERL_MAGIC_taint\\(t\\)'); |
439 | |
9248c45a |
440 | END { |
92e5451f |
441 | 1 while unlink("peek$$"); |
9248c45a |
442 | } |
6bf47b08 |
443 | |
444 | # blessed refs |
445 | do_test(22, |
446 | bless(\\undef, 'Foobar'), |
447 | 'SV = RV\\($ADDR\\) at $ADDR |
448 | REFCNT = 1 |
449 | FLAGS = \\(ROK\\) |
450 | RV = $ADDR |
451 | SV = PVMG\\($ADDR\\) at $ADDR |
452 | REFCNT = 2 |
453 | FLAGS = \\(OBJECT,ROK\\) |
7957ad98 |
454 | IV = -?\d+ |
455 | NV = $FLOAT |
6bf47b08 |
456 | RV = $ADDR |
457 | SV = NULL\\(0x0\\) at $ADDR |
458 | REFCNT = \d+ |
459 | FLAGS = \\(READONLY\\) |
460 | PV = $ADDR "" |
461 | CUR = 0 |
462 | LEN = 0 |
463 | STASH = $ADDR\s+"Foobar"'); |