6 require Config; import Config;
7 if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) {
8 print "1..0 # Skip: Devel::Peek was not built\n";
20 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
24 if (open(OUT,">peek$$")) {
25 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
27 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
29 if (open(IN, "peek$$")) {
31 $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
32 $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
33 # handle DEBUG_LEAKING_SCALARS prefix
34 $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
36 $pattern =~ s/^ *\$XSUB *\n/
37 ($] < 5.009) ? " XSUB = 0\n XSUBANY = 0\n" : '';
39 $pattern =~ s/^ *\$ROOT *\n/
40 ($] < 5.009) ? " ROOT = 0x0\n" : '';
42 $pattern =~ s/^ *\$IVNV *\n/
43 ($] < 5.009) ? " IV = 0\n NV = 0\n" : '';
46 print $pattern, "\n" if $DEBUG;
48 print $dump, "\n" if $DEBUG;
49 like( $dump, qr/\A$pattern\Z/ms );
53 die "$0: failed to open peek$$: !\n";
56 die "$0: failed to create peek$$: $!\n";
66 1 while unlink("peek$$");
71 'SV = PV\\($ADDR\\) at $ADDR
73 FLAGS = \\(POK,pPOK\\)
81 'SV = PV\\($ADDR\\) at $ADDR
83 FLAGS = \\(.*POK,READONLY,pPOK\\)
90 'SV = IV\\($ADDR\\) at $ADDR
92 FLAGS = \\(IOK,pIOK\\)
97 'SV = IV\\($ADDR\\) at $ADDR
99 FLAGS = \\(.*IOK,READONLY,pIOK\\)
104 'SV = IV\\($ADDR\\) at $ADDR
106 FLAGS = \\(PADMY,IOK,pIOK\\)
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.
114 my $type = do_test( 6,
116 'SV = ([NI])V\\($ADDR\\) at $ADDR
118 FLAGS = \\(PADTMP,\1OK,p\1OK\\)
125 'SV = PVNV\\($ADDR\\) at $ADDR
127 FLAGS = \\(NOK,pNOK\\)
129 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
136 'SV = IV\\($ADDR\\) at $ADDR
138 FLAGS = \\(.*IOK,READONLY,pIOK\\)
143 'SV = NULL\\(0x0\\) at $ADDR
149 'SV = RV\\($ADDR\\) at $ADDR
153 SV = PV\\($ADDR\\) at $ADDR
155 FLAGS = \\(POK,pPOK\\)
163 SV = PVNV\\($ADDR\\) at $ADDR
165 FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
171 SV = IV\\($ADDR\\) at $ADDR
173 FLAGS = \\(IOK,pIOK\\)
178 'SV = RV\\($ADDR\\) at $ADDR
182 SV = PVAV\\($ADDR\\) at $ADDR
191 SV = IV\\($ADDR\\) at $ADDR
193 FLAGS = \\(IOK,pIOK\\)
195 Elt No. 1' . $c_pattern);
199 'SV = RV\\($ADDR\\) at $ADDR
203 SV = PVHV\\($ADDR\\) at $ADDR
205 FLAGS = \\(SHAREKEYS\\)
206 ARRAY = $ADDR \\(0:7, 1:1\\)
207 hash quality = 100.0%
213 Elt "123" HASH = $ADDR' . $c_pattern);
217 'SV = RV\\($ADDR\\) at $ADDR
221 SV = PVCV\\($ADDR\\) at $ADDR
223 FLAGS = \\(PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
226 COMP_STASH = $ADDR\\t"main"
227 START = $ADDR ===> \\d+
230 GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
231 FILE = ".*\\b(?i:peek\\.t)"
238 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
239 OUTSIDE = $ADDR \\(MAIN\\)');
243 'SV = RV\\($ADDR\\) at $ADDR
247 SV = PVCV\\($ADDR\\) at $ADDR
251 COMP_STASH = $ADDR\\t"main"
252 START = $ADDR ===> \\d+
255 GVGV::GV = $ADDR\\t"main" :: "do_test"
256 FILE = ".*\\b(?i:peek\\.t)"
263 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
264 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
265 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0
266 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
267 OUTSIDE = $ADDR \\(MAIN\\)');
271 'SV = RV\\($ADDR\\) at $ADDR
275 SV = PVMG\\($ADDR\\) at $ADDR
277 FLAGS = \\(OBJECT,SMG\\)
283 MG_TYPE = PERL_MAGIC_qr\(r\)
285 STASH = $ADDR\\t"Regexp"');
289 'SV = RV\\($ADDR\\) at $ADDR
293 SV = PVHV\\($ADDR\\) at $ADDR
295 FLAGS = \\(OBJECT,SHAREKEYS\\)
296 STASH = $ADDR\\t"Tac"
306 'SV = PVGV\\($ADDR\\) at $ADDR
308 FLAGS = \\(SCREAM,MULTI(?:,IN_PAD)?\\)
311 GvSTASH = $ADDR\\t"main"
322 FILE = ".*\\b(?i:peek\\.t)"
326 if (ord('A') == 193) {
328 chr(256).chr(0).chr(512),
329 'SV = PV\\($ADDR\\) at $ADDR
331 FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
332 PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
337 chr(256).chr(0).chr(512),
338 'SV = PV\\($ADDR\\) at $ADDR
340 FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
341 PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
346 if (ord('A') == 193) {
348 {chr(256)=>chr(512)},
349 'SV = RV\\($ADDR\\) at $ADDR
353 SV = PVHV\\($ADDR\\) at $ADDR
355 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
356 ARRAY = $ADDR \\(0:7, 1:1\\)
357 hash quality = 100.0%
363 Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
364 SV = PV\\($ADDR\\) at $ADDR
366 FLAGS = \\(POK,pPOK,UTF8\\)
367 PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
372 {chr(256)=>chr(512)},
373 'SV = RV\\($ADDR\\) at $ADDR
377 SV = PVHV\\($ADDR\\) at $ADDR
379 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
380 ARRAY = $ADDR \\(0:7, 1:1\\)
381 hash quality = 100.0%
387 Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
388 SV = PV\\($ADDR\\) at $ADDR
390 FLAGS = \\(POK,pPOK,UTF8\\)
391 PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
400 'SV = PVMG\\($ADDR\\) at $ADDR
402 FLAGS = \\(PADMY,SMG,POK,pPOK\\)
409 MG_VIRTUAL = &PL_vtbl_mglob
410 MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
415 # TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
416 # environment variables may be invisibly case-forced, hence the (?i:PATH)
417 # C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
418 # VMS is setting FAKE and READONLY flags. What VMS uses for storing
419 # ENV hashes is also not always null terminated.
422 $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
423 'SV = PVMG\\($ADDR\\) at $ADDR
425 FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
432 MG_VIRTUAL = &PL_vtbl_envelem
433 MG_TYPE = PERL_MAGIC_envelem\\(e\\)
437 MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
438 SV = PV(?:IV)?\\($ADDR\\) at $ADDR
440 FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
442 )? PV = $ADDR "(?i:PATH)"(?:\\\0)?
446 MG_VIRTUAL = &PL_vtbl_taint
447 MG_TYPE = PERL_MAGIC_taint\\(t\\)');
451 bless(\\undef, 'Foobar'),
452 'SV = RV\\($ADDR\\) at $ADDR
456 SV = PVMG\\($ADDR\\) at $ADDR
458 FLAGS = \\(OBJECT,ROK\\)
462 SV = NULL\\(0x0\\) at $ADDR
464 FLAGS = \\(READONLY\\)
468 STASH = $ADDR\s+"Foobar"');
470 # Constant subroutines
478 'SV = RV\\($ADDR\\) at $ADDR
482 SV = PVCV\\($ADDR\\) at $ADDR
484 FLAGS = \\(POK,pPOK,CONST\\)
490 XSUBANY = $ADDR \\(CONST SV\\)
491 SV = PV\\($ADDR\\) at $ADDR
493 FLAGS = \\(.*POK,READONLY,pPOK\\)
494 PV = $ADDR "Perl rules"\\\0
497 GVGV::GV = $ADDR\\t"main" :: "const"
498 FILE = ".*\\b(?i:peek\\.t)"
505 OUTSIDE = 0x0 \\(null\\)');