move all pad-related code to its own src file
[p5sagit/p5-mst-13.2.git] / ext / Devel / Peek / Peek.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
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
13 use Devel::Peek;
14
15 print "1..19\n";
16
17 our $DEBUG = 0;
18 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
19
20 sub do_test {
21     my $pattern = pop;
22     if (open(OUT,">peek$$")) {
23         open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
24         Dump($_[1]);
25         open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
26         close(OUT);
27         if (open(IN, "peek$$")) {
28             local $/;
29             $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
30             $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
31             print $pattern, "\n" if $DEBUG;
32             my $dump = <IN>;
33             print $dump, "\n"    if $DEBUG;
34             print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
35             print "ok $_[0]\n";
36             close(IN);
37             return $1;
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;
49 local $d = 0;
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
58   LEN = \\d+'
59        );
60
61 do_test( 2,
62         "bar",
63 'SV = PV\\($ADDR\\) at $ADDR
64   REFCNT = 1
65   FLAGS = \\(.*POK,READONLY,pPOK\\)
66   PV = $ADDR "bar"\\\0
67   CUR = 3
68   LEN = \\d+');
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
81   FLAGS = \\(.*IOK,READONLY,pIOK\\)
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
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,
97         $c + $d,
98 'SV = ([NI])V\\($ADDR\\) at $ADDR
99   REFCNT = 1
100   FLAGS = \\(PADTMP,\1OK,p\1OK\\)
101   \1V = 456');
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
111   NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
112   PV = $ADDR "789"\\\0
113   CUR = 3
114   LEN = \\d+');
115
116 do_test( 8,
117         0xabcd,
118 'SV = IV\\($ADDR\\) at $ADDR
119   REFCNT = 1
120   FLAGS = \\(.*IOK,READONLY,pIOK\\)
121   IV = 43981');
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
140     LEN = \\d+');
141
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 }
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
179     Elt No. 1' . $c_pattern);
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
191     NV = $FLOAT
192     ARRAY = $ADDR  \\(0:7, 1:1\\)
193     hash quality = 100.0%
194     KEYS = 1
195     FILL = 1
196     MAX = 7
197     RITER = -1
198     EITER = 0x0
199     Elt "123" HASH = $ADDR' . $c_pattern);
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
218     GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
219     FILE = ".*\\b(?i:peek\\.t)"
220     DEPTH = 0
221 (?:    MUTEXP = $ADDR
222     OWNER = $ADDR
223 )?    FLAGS = 0x4
224     PADLIST = $ADDR
225     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
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
235     REFCNT = (3|4)
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"
245     FILE = ".*\\b(?i:peek\\.t)"
246     DEPTH = 1
247 (?:    MUTEXP = $ADDR
248     OWNER = $ADDR
249 )?    FLAGS = 0x0
250     PADLIST = $ADDR
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"
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
271       MG_TYPE = PERL_MAGIC_qr\(r\)
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
298   FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
299   IV = 0
300   NV = 0
301   MAGIC = $ADDR
302     MG_VIRTUAL = &PL_vtbl_glob
303     MG_TYPE = PERL_MAGIC_glob\(\*\)
304     MG_OBJ = $ADDR
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
318     LINE = \\d+
319     FILE = ".*\\b(?i:peek\\.t)"
320     FLAGS = $ADDR
321     EGV = $ADDR\\t"a"');
322
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
331   LEN = \\d+');
332 } else {
333 do_test(18,
334         chr(256).chr(0).chr(512),
335 'SV = PV\\($ADDR\\) at $ADDR
336   REFCNT = 1
337   FLAGS = \\((?:PADBUSY,PADTMP,)?POK,READONLY,pPOK,UTF8\\)
338   PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
339   CUR = 5
340   LEN = \\d+');
341 }
342
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
352     FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
353     UV = 1
354     NV = $FLOAT
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
362     Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
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
368       LEN = \\d+');
369 } else {
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
378     FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
379     UV = 1
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
394       LEN = \\d+');
395 }
396
397 END {
398   1 while unlink("peek$$");
399 }