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; |
e7ecf62c |
7 | if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) { |
9ec58fb7 |
8 | print "1..0 # Skip: Devel::Peek was not built\n"; |
9 | exit 0; |
10 | } |
11 | } |
12 | |
768fd157 |
13 | BEGIN { require "./test.pl"; } |
e7ecf62c |
14 | |
9248c45a |
15 | use Devel::Peek; |
16 | |
c0a413d1 |
17 | plan(50); |
9248c45a |
18 | |
19 | our $DEBUG = 0; |
277ddfaf |
20 | open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!"; |
9248c45a |
21 | |
22 | sub do_test { |
000fd473 |
23 | my $todo = $_[3]; |
24 | my $repeat_todo = $_[4]; |
25 | my $pattern = $_[2]; |
277ddfaf |
26 | if (open(OUT,">peek$$")) { |
27 | open(STDERR, ">&OUT") or die "Can't dup OUT: $!"; |
9248c45a |
28 | Dump($_[1]); |
e9569a7a |
29 | print STDERR "*****\n"; |
30 | Dump($_[1]); # second dump to compare with the first to make sure nothing changed. |
277ddfaf |
31 | open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!"; |
32 | close(OUT); |
9248c45a |
33 | if (open(IN, "peek$$")) { |
34 | local $/; |
35 | $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g; |
8aacddc1 |
36 | $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g; |
fd0854ff |
37 | # handle DEBUG_LEAKING_SCALARS prefix |
d94a5950 |
38 | $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg; |
bf53b3a5 |
39 | |
000fd473 |
40 | # Need some clear generic mechanism to eliminate (or add) lines |
41 | # of dump output dependant on perl version. The (previous) use of |
42 | # things like $IVNV gave the illusion that the string passed in was |
43 | # a regexp into which variables were interpolated, but this wasn't |
44 | # actually true as those 'variables' actually also ate the |
45 | # whitspace on the line. So it seems better to mark lines that |
46 | # need to be eliminated. I considered (?# ... ) and (?{ ... }), |
47 | # but whilst embedded code or comment syntax would keep it as a |
48 | # legitimate regexp, it still isn't true. Seems easier and clearer |
49 | # things that look like comments. |
50 | |
51 | # Could do this is in a s///mge but seems clearer like this: |
52 | $pattern = join '', map { |
53 | # If we identify the version condition, take *it* out whatever |
54 | s/\s*# (\$] [<>]=? 5\.\d\d\d)$// |
55 | ? (eval $1 ? $_ : '') |
56 | : $_ # Didn't match, so this line is in |
57 | } split /^/, $pattern; |
58 | |
59 | $pattern =~ s/\$PADMY/ |
60 | ($] < 5.009) ? 'PADBUSY,PADMY' : 'PADMY'; |
61 | /mge; |
62 | $pattern =~ s/\$PADTMP/ |
63 | ($] < 5.009) ? 'PADBUSY,PADTMP' : 'PADTMP'; |
64 | /mge; |
d04ba589 |
65 | $pattern =~ s/^ *\$XSUB *\n/ |
34913379 |
66 | ($] < 5.009) ? " XSUB = 0x0\n XSUBANY = 0\n" : ''; |
bf53b3a5 |
67 | /mge; |
d04ba589 |
68 | $pattern =~ s/^ *\$ROOT *\n/ |
69 | ($] < 5.009) ? " ROOT = 0x0\n" : ''; |
70 | /mge; |
c84c4652 |
71 | $pattern =~ s/^ *\$IVNV *\n/ |
72 | ($] < 5.009) ? " IV = 0\n NV = 0\n" : ''; |
73 | /mge; |
2b631c93 |
74 | $pattern =~ s/\$RV/ |
75 | ($] < 5.011) ? 'RV' : 'IV'; |
76 | /mge; |
c0a413d1 |
77 | $pattern =~ s/^ *\$NV *\n/ |
78 | ($] < 5.011) ? " NV = 0\n" : ''; |
79 | /mge; |
98deaf8b |
80 | $pattern =~ s/^ *\$SUBPROCESS *\n/ |
81 | ($] < 5.009) ? " SUBPROCESS = 0\n" : ''; |
82 | /mge; |
83 | |
d04ba589 |
84 | |
9248c45a |
85 | print $pattern, "\n" if $DEBUG; |
e9569a7a |
86 | my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>; |
9248c45a |
87 | print $dump, "\n" if $DEBUG; |
e7ecf62c |
88 | like( $dump, qr/\A$pattern\Z/ms ); |
e9569a7a |
89 | |
000fd473 |
90 | local $TODO = $repeat_todo; |
e9569a7a |
91 | is($dump2, $dump); |
92 | |
9248c45a |
93 | close(IN); |
e9569a7a |
94 | |
59d8ce62 |
95 | return $1; |
9248c45a |
96 | } else { |
97 | die "$0: failed to open peek$$: !\n"; |
98 | } |
99 | } else { |
100 | die "$0: failed to create peek$$: $!\n"; |
101 | } |
102 | } |
103 | |
104 | our $a; |
105 | our $b; |
106 | my $c; |
208edb77 |
107 | local $d = 0; |
9248c45a |
108 | |
e7ecf62c |
109 | END { |
110 | 1 while unlink("peek$$"); |
111 | } |
bf53b3a5 |
112 | |
9248c45a |
113 | do_test( 1, |
114 | $a = "foo", |
115 | 'SV = PV\\($ADDR\\) at $ADDR |
116 | REFCNT = 1 |
117 | FLAGS = \\(POK,pPOK\\) |
118 | PV = $ADDR "foo"\\\0 |
119 | CUR = 3 |
1badabf5 |
120 | LEN = \\d+' |
9248c45a |
121 | ); |
122 | |
123 | do_test( 2, |
124 | "bar", |
125 | 'SV = PV\\($ADDR\\) at $ADDR |
126 | REFCNT = 1 |
7766e686 |
127 | FLAGS = \\(.*POK,READONLY,pPOK\\) |
9248c45a |
128 | PV = $ADDR "bar"\\\0 |
129 | CUR = 3 |
1badabf5 |
130 | LEN = \\d+'); |
9248c45a |
131 | |
132 | do_test( 3, |
133 | $b = 123, |
134 | 'SV = IV\\($ADDR\\) at $ADDR |
135 | REFCNT = 1 |
136 | FLAGS = \\(IOK,pIOK\\) |
137 | IV = 123'); |
138 | |
139 | do_test( 4, |
140 | 456, |
141 | 'SV = IV\\($ADDR\\) at $ADDR |
142 | REFCNT = 1 |
7766e686 |
143 | FLAGS = \\(.*IOK,READONLY,pIOK\\) |
9248c45a |
144 | IV = 456'); |
145 | |
146 | do_test( 5, |
147 | $c = 456, |
148 | 'SV = IV\\($ADDR\\) at $ADDR |
149 | REFCNT = 1 |
000fd473 |
150 | FLAGS = \\($PADMY,IOK,pIOK\\) |
9248c45a |
151 | IV = 456'); |
152 | |
59d8ce62 |
153 | # If perl is built with PERL_PRESERVE_IVUV then maths is done as integers |
154 | # where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then |
155 | # maths is done in floating point always, and this scalar will be an NV. |
156 | # ([NI]) captures the type, referred to by \1 in this regexp and $type for |
157 | # building subsequent regexps. |
158 | my $type = do_test( 6, |
9248c45a |
159 | $c + $d, |
59d8ce62 |
160 | 'SV = ([NI])V\\($ADDR\\) at $ADDR |
9248c45a |
161 | REFCNT = 1 |
59d8ce62 |
162 | FLAGS = \\(PADTMP,\1OK,p\1OK\\) |
163 | \1V = 456'); |
9248c45a |
164 | |
165 | ($d = "789") += 0.1; |
166 | |
167 | do_test( 7, |
168 | $d, |
169 | 'SV = PVNV\\($ADDR\\) at $ADDR |
170 | REFCNT = 1 |
171 | FLAGS = \\(NOK,pNOK\\) |
78d00c47 |
172 | IV = \d+ |
ac634a9a |
173 | NV = 789\\.(?:1(?:000+\d+)?|0999+\d+) |
9248c45a |
174 | PV = $ADDR "789"\\\0 |
175 | CUR = 3 |
1badabf5 |
176 | LEN = \\d+'); |
9248c45a |
177 | |
178 | do_test( 8, |
179 | 0xabcd, |
180 | 'SV = IV\\($ADDR\\) at $ADDR |
181 | REFCNT = 1 |
28e5dec8 |
182 | FLAGS = \\(.*IOK,READONLY,pIOK\\) |
183 | IV = 43981'); |
9248c45a |
184 | |
185 | do_test( 9, |
186 | undef, |
187 | 'SV = NULL\\(0x0\\) at $ADDR |
188 | REFCNT = 1 |
189 | FLAGS = \\(\\)'); |
190 | |
191 | do_test(10, |
192 | \$a, |
4df7f6af |
193 | 'SV = $RV\\($ADDR\\) at $ADDR |
9248c45a |
194 | REFCNT = 1 |
195 | FLAGS = \\(ROK\\) |
196 | RV = $ADDR |
197 | SV = PV\\($ADDR\\) at $ADDR |
198 | REFCNT = 2 |
199 | FLAGS = \\(POK,pPOK\\) |
200 | PV = $ADDR "foo"\\\0 |
201 | CUR = 3 |
1badabf5 |
202 | LEN = \\d+'); |
9248c45a |
203 | |
59d8ce62 |
204 | my $c_pattern; |
205 | if ($type eq 'N') { |
206 | $c_pattern = ' |
207 | SV = PVNV\\($ADDR\\) at $ADDR |
208 | REFCNT = 1 |
209 | FLAGS = \\(IOK,NOK,pIOK,pNOK\\) |
210 | IV = 456 |
211 | NV = 456 |
212 | PV = 0'; |
213 | } else { |
214 | $c_pattern = ' |
215 | SV = IV\\($ADDR\\) at $ADDR |
216 | REFCNT = 1 |
217 | FLAGS = \\(IOK,pIOK\\) |
218 | IV = 456'; |
219 | } |
9248c45a |
220 | do_test(11, |
221 | [$b,$c], |
4df7f6af |
222 | 'SV = $RV\\($ADDR\\) at $ADDR |
9248c45a |
223 | REFCNT = 1 |
224 | FLAGS = \\(ROK\\) |
225 | RV = $ADDR |
226 | SV = PVAV\\($ADDR\\) at $ADDR |
78c72037 |
227 | REFCNT = 1 |
9248c45a |
228 | FLAGS = \\(\\) |
000fd473 |
229 | IV = 0 # $] < 5.009 |
230 | NV = 0 # $] < 5.009 |
9248c45a |
231 | ARRAY = $ADDR |
232 | FILL = 1 |
233 | MAX = 1 |
234 | ARYLEN = 0x0 |
235 | FLAGS = \\(REAL\\) |
236 | Elt No. 0 |
237 | SV = IV\\($ADDR\\) at $ADDR |
238 | REFCNT = 1 |
239 | FLAGS = \\(IOK,pIOK\\) |
240 | IV = 123 |
59d8ce62 |
241 | Elt No. 1' . $c_pattern); |
9248c45a |
242 | |
243 | do_test(12, |
244 | {$b=>$c}, |
4df7f6af |
245 | 'SV = $RV\\($ADDR\\) at $ADDR |
9248c45a |
246 | REFCNT = 1 |
247 | FLAGS = \\(ROK\\) |
248 | RV = $ADDR |
249 | SV = PVHV\\($ADDR\\) at $ADDR |
78c72037 |
250 | REFCNT = 1 |
9248c45a |
251 | FLAGS = \\(SHAREKEYS\\) |
000fd473 |
252 | IV = 1 # $] < 5.009 |
253 | NV = $FLOAT # $] < 5.009 |
9248c45a |
254 | ARRAY = $ADDR \\(0:7, 1:1\\) |
b8fa94d8 |
255 | hash quality = 100.0% |
9248c45a |
256 | KEYS = 1 |
257 | FILL = 1 |
258 | MAX = 7 |
259 | RITER = -1 |
260 | EITER = 0x0 |
000fd473 |
261 | Elt "123" HASH = $ADDR' . $c_pattern, |
262 | '', |
263 | $] > 5.009 && 'The hash iterator used in dump.c sets the OOK flag'); |
9248c45a |
264 | |
265 | do_test(13, |
266 | sub(){@_}, |
4df7f6af |
267 | 'SV = $RV\\($ADDR\\) at $ADDR |
9248c45a |
268 | REFCNT = 1 |
269 | FLAGS = \\(ROK\\) |
270 | RV = $ADDR |
271 | SV = PVCV\\($ADDR\\) at $ADDR |
272 | REFCNT = 2 |
000fd473 |
273 | FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\) |
c84c4652 |
274 | $IVNV |
9248c45a |
275 | PROTOTYPE = "" |
276 | COMP_STASH = $ADDR\\t"main" |
277 | START = $ADDR ===> \\d+ |
278 | ROOT = $ADDR |
d04ba589 |
279 | $XSUB |
208edb77 |
280 | GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*" |
084d946d |
281 | FILE = ".*\\b(?i:peek\\.t)" |
000fd473 |
282 | DEPTH = 0(?: |
283 | MUTEXP = $ADDR |
284 | OWNER = $ADDR)? |
285 | FLAGS = 0x404 # $] < 5.009 |
286 | FLAGS = 0x90 # $] >= 5.009 |
a3985cdc |
287 | OUTSIDE_SEQ = \\d+ |
9248c45a |
288 | PADLIST = $ADDR |
dd2155a4 |
289 | PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) |
9248c45a |
290 | OUTSIDE = $ADDR \\(MAIN\\)'); |
291 | |
292 | do_test(14, |
293 | \&do_test, |
4df7f6af |
294 | 'SV = $RV\\($ADDR\\) at $ADDR |
9248c45a |
295 | REFCNT = 1 |
296 | FLAGS = \\(ROK\\) |
297 | RV = $ADDR |
298 | SV = PVCV\\($ADDR\\) at $ADDR |
9856a127 |
299 | REFCNT = (3|4) |
9248c45a |
300 | FLAGS = \\(\\) |
c84c4652 |
301 | $IVNV |
9248c45a |
302 | COMP_STASH = $ADDR\\t"main" |
303 | START = $ADDR ===> \\d+ |
304 | ROOT = $ADDR |
d04ba589 |
305 | $XSUB |
9248c45a |
306 | GVGV::GV = $ADDR\\t"main" :: "do_test" |
084d946d |
307 | FILE = ".*\\b(?i:peek\\.t)" |
9248c45a |
308 | DEPTH = 1 |
9856a127 |
309 | (?: MUTEXP = $ADDR |
208edb77 |
310 | OWNER = $ADDR |
311 | )? FLAGS = 0x0 |
a3985cdc |
312 | OUTSIDE_SEQ = \\d+ |
9248c45a |
313 | PADLIST = $ADDR |
dd2155a4 |
314 | PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) |
000fd473 |
315 | \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$todo" |
316 | \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$repeat_todo" |
ee6cee0c |
317 | \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern" |
000fd473 |
318 | \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" # $] < 5.009 |
319 | \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 # $] >= 5.009 |
ee6cee0c |
320 | \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump" |
e9569a7a |
321 | \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2" |
9248c45a |
322 | OUTSIDE = $ADDR \\(MAIN\\)'); |
323 | |
3ce3ed55 |
324 | if ($] >= 5.011) { |
325 | do_test(15, |
326 | qr(tic), |
327 | 'SV = $RV\\($ADDR\\) at $ADDR |
328 | REFCNT = 1 |
329 | FLAGS = \\(ROK\\) |
330 | RV = $ADDR |
5c35adbb |
331 | SV = REGEXP\\($ADDR\\) at $ADDR |
288b8c02 |
332 | REFCNT = 2 |
0fc92fc6 |
333 | FLAGS = \\(OBJECT,POK,pPOK\\) |
3ce3ed55 |
334 | IV = 0 |
f7c278bf |
335 | PV = $ADDR "\\(\\?-xism:tic\\)"\\\0 |
336 | CUR = 12 |
0fc92fc6 |
337 | LEN = \\d+ |
338 | STASH = $ADDR\\t"Regexp"'); |
3ce3ed55 |
339 | } else { |
9248c45a |
340 | do_test(15, |
341 | qr(tic), |
4df7f6af |
342 | 'SV = $RV\\($ADDR\\) at $ADDR |
9248c45a |
343 | REFCNT = 1 |
344 | FLAGS = \\(ROK\\) |
345 | RV = $ADDR |
346 | SV = PVMG\\($ADDR\\) at $ADDR |
347 | REFCNT = 1 |
faf82a0b |
348 | FLAGS = \\(OBJECT,SMG\\) |
9248c45a |
349 | IV = 0 |
350 | NV = 0 |
351 | PV = 0 |
352 | MAGIC = $ADDR |
353 | MG_VIRTUAL = $ADDR |
14befaf4 |
354 | MG_TYPE = PERL_MAGIC_qr\(r\) |
9248c45a |
355 | MG_OBJ = $ADDR |
000fd473 |
356 | PAT = "\(\?-xism:tic\)" # $] >= 5.009 |
357 | REFCNT = 2 # $] >= 5.009 |
9248c45a |
358 | STASH = $ADDR\\t"Regexp"'); |
3ce3ed55 |
359 | } |
9248c45a |
360 | |
361 | do_test(16, |
362 | (bless {}, "Tac"), |
4df7f6af |
363 | 'SV = $RV\\($ADDR\\) at $ADDR |
9248c45a |
364 | REFCNT = 1 |
365 | FLAGS = \\(ROK\\) |
366 | RV = $ADDR |
367 | SV = PVHV\\($ADDR\\) at $ADDR |
78c72037 |
368 | REFCNT = 1 |
9248c45a |
369 | FLAGS = \\(OBJECT,SHAREKEYS\\) |
000fd473 |
370 | IV = 0 # $] < 5.009 |
371 | NV = 0 # $] < 5.009 |
9248c45a |
372 | STASH = $ADDR\\t"Tac" |
373 | ARRAY = 0x0 |
374 | KEYS = 0 |
375 | FILL = 0 |
376 | MAX = 7 |
377 | RITER = -1 |
000fd473 |
378 | EITER = 0x0', '', |
379 | $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag' |
380 | : "Something causes the HV's array to become allocated"); |
9248c45a |
381 | |
382 | do_test(17, |
383 | *a, |
384 | 'SV = PVGV\\($ADDR\\) at $ADDR |
385 | REFCNT = 5 |
000fd473 |
386 | FLAGS = \\(MULTI(?:,IN_PAD)?\\) # $] >= 5.009 |
387 | FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\) # $] < 5.009 |
388 | IV = 0 # $] < 5.009 |
389 | NV = 0 # $] < 5.009 |
390 | PV = 0 # $] < 5.009 |
391 | MAGIC = $ADDR # $] < 5.009 |
392 | MG_VIRTUAL = &PL_vtbl_glob # $] < 5.009 |
393 | MG_TYPE = PERL_MAGIC_glob\(\*\) # $] < 5.009 |
394 | MG_OBJ = $ADDR # $] < 5.009 |
9248c45a |
395 | NAME = "a" |
396 | NAMELEN = 1 |
397 | GvSTASH = $ADDR\\t"main" |
398 | GP = $ADDR |
399 | SV = $ADDR |
400 | REFCNT = 1 |
401 | IO = 0x0 |
402 | FORM = 0x0 |
403 | AV = 0x0 |
404 | HV = 0x0 |
405 | CV = 0x0 |
406 | CVGEN = 0x0 |
000fd473 |
407 | GPFLAGS = 0x0 # $] < 5.009 |
9ec58fb7 |
408 | LINE = \\d+ |
084d946d |
409 | FILE = ".*\\b(?i:peek\\.t)" |
e39917cc |
410 | FLAGS = $ADDR |
9248c45a |
411 | EGV = $ADDR\\t"a"'); |
412 | |
cdb2dd7b |
413 | if (ord('A') == 193) { |
414 | do_test(18, |
415 | chr(256).chr(0).chr(512), |
416 | 'SV = PV\\($ADDR\\) at $ADDR |
417 | REFCNT = 1 |
000fd473 |
418 | FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) |
cdb2dd7b |
419 | PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\] |
420 | CUR = 5 |
1badabf5 |
421 | LEN = \\d+'); |
cdb2dd7b |
422 | } else { |
e6abe6d8 |
423 | do_test(18, |
424 | chr(256).chr(0).chr(512), |
425 | 'SV = PV\\($ADDR\\) at $ADDR |
426 | REFCNT = 1 |
000fd473 |
427 | FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) |
98c991d1 |
428 | PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\] |
e6abe6d8 |
429 | CUR = 5 |
1badabf5 |
430 | LEN = \\d+'); |
cdb2dd7b |
431 | } |
e6abe6d8 |
432 | |
cdb2dd7b |
433 | if (ord('A') == 193) { |
434 | do_test(19, |
435 | {chr(256)=>chr(512)}, |
4df7f6af |
436 | 'SV = $RV\\($ADDR\\) at $ADDR |
cdb2dd7b |
437 | REFCNT = 1 |
438 | FLAGS = \\(ROK\\) |
439 | RV = $ADDR |
440 | SV = PVHV\\($ADDR\\) at $ADDR |
78c72037 |
441 | REFCNT = 1 |
b2caaddd |
442 | FLAGS = \\(SHAREKEYS,HASKFLAGS\\) |
000fd473 |
443 | UV = 1 # $] < 5.009 |
444 | NV = $FLOAT # $] < 5.009 |
cdb2dd7b |
445 | ARRAY = $ADDR \\(0:7, 1:1\\) |
446 | hash quality = 100.0% |
447 | KEYS = 1 |
448 | FILL = 1 |
449 | MAX = 7 |
450 | RITER = -1 |
451 | EITER = $ADDR |
6cbfa5b4 |
452 | Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR |
cdb2dd7b |
453 | SV = PV\\($ADDR\\) at $ADDR |
454 | REFCNT = 1 |
455 | FLAGS = \\(POK,pPOK,UTF8\\) |
456 | PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\] |
457 | CUR = 2 |
000fd473 |
458 | LEN = \\d+', |
459 | $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag' |
460 | : 'sv_length has been called on the element, and cached the result in MAGIC'); |
cdb2dd7b |
461 | } else { |
98c991d1 |
462 | do_test(19, |
463 | {chr(256)=>chr(512)}, |
4df7f6af |
464 | 'SV = $RV\\($ADDR\\) at $ADDR |
98c991d1 |
465 | REFCNT = 1 |
466 | FLAGS = \\(ROK\\) |
467 | RV = $ADDR |
468 | SV = PVHV\\($ADDR\\) at $ADDR |
78c72037 |
469 | REFCNT = 1 |
19692e8d |
470 | FLAGS = \\(SHAREKEYS,HASKFLAGS\\) |
000fd473 |
471 | UV = 1 # $] < 5.009 |
472 | NV = 0 # $] < 5.009 |
98c991d1 |
473 | ARRAY = $ADDR \\(0:7, 1:1\\) |
474 | hash quality = 100.0% |
475 | KEYS = 1 |
476 | FILL = 1 |
477 | MAX = 7 |
478 | RITER = -1 |
479 | EITER = $ADDR |
480 | Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR |
481 | SV = PV\\($ADDR\\) at $ADDR |
482 | REFCNT = 1 |
483 | FLAGS = \\(POK,pPOK,UTF8\\) |
484 | PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\] |
485 | CUR = 2 |
000fd473 |
486 | LEN = \\d+', '', |
487 | $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag' |
488 | : 'sv_length has been called on the element, and cached the result in MAGIC'); |
cdb2dd7b |
489 | } |
98c991d1 |
490 | |
99331854 |
491 | my $x=""; |
492 | $x=~/.??/g; |
493 | do_test(20, |
494 | $x, |
495 | 'SV = PVMG\\($ADDR\\) at $ADDR |
496 | REFCNT = 1 |
000fd473 |
497 | FLAGS = \\($PADMY,SMG,POK,pPOK\\) |
99331854 |
498 | IV = 0 |
499 | NV = 0 |
500 | PV = $ADDR ""\\\0 |
501 | CUR = 0 |
1936d2a7 |
502 | LEN = \d+ |
99331854 |
503 | MAGIC = $ADDR |
504 | MG_VIRTUAL = &PL_vtbl_mglob |
505 | MG_TYPE = PERL_MAGIC_regex_global\\(g\\) |
506 | MG_FLAGS = 0x01 |
507 | MINMATCH'); |
508 | |
f24fdb76 |
509 | # |
510 | # TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS |
511 | # environment variables may be invisibly case-forced, hence the (?i:PATH) |
5e836f43 |
512 | # C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)? |
d9baf692 |
513 | # VMS is setting FAKE and READONLY flags. What VMS uses for storing |
514 | # ENV hashes is also not always null terminated. |
f24fdb76 |
515 | # |
99331854 |
516 | do_test(21, |
517 | $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value |
518 | 'SV = PVMG\\($ADDR\\) at $ADDR |
519 | REFCNT = 1 |
520 | FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\) |
521 | IV = 0 |
522 | NV = 0 |
523 | PV = $ADDR "0"\\\0 |
524 | CUR = 1 |
525 | LEN = \d+ |
526 | MAGIC = $ADDR |
527 | MG_VIRTUAL = &PL_vtbl_envelem |
528 | MG_TYPE = PERL_MAGIC_envelem\\(e\\) |
d25a523c |
529 | (?: MG_FLAGS = 0x01 |
99331854 |
530 | TAINTEDDIR |
143a3e5e |
531 | )? MG_LEN = -?\d+ |
532 | MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY |
5e836f43 |
533 | SV = PV(?:IV)?\\($ADDR\\) at $ADDR |
143a3e5e |
534 | REFCNT = \d+ |
11e2783c |
535 | FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\) |
f0fabfd7 |
536 | (?: IV = 0 |
d9baf692 |
537 | )? PV = $ADDR "(?i:PATH)"(?:\\\0)? |
143a3e5e |
538 | CUR = \d+ |
539 | LEN = \d+) |
99331854 |
540 | MAGIC = $ADDR |
541 | MG_VIRTUAL = &PL_vtbl_taint |
542 | MG_TYPE = PERL_MAGIC_taint\\(t\\)'); |
543 | |
6bf47b08 |
544 | # blessed refs |
545 | do_test(22, |
546 | bless(\\undef, 'Foobar'), |
4df7f6af |
547 | 'SV = $RV\\($ADDR\\) at $ADDR |
6bf47b08 |
548 | REFCNT = 1 |
549 | FLAGS = \\(ROK\\) |
550 | RV = $ADDR |
551 | SV = PVMG\\($ADDR\\) at $ADDR |
552 | REFCNT = 2 |
553 | FLAGS = \\(OBJECT,ROK\\) |
7957ad98 |
554 | IV = -?\d+ |
555 | NV = $FLOAT |
6bf47b08 |
556 | RV = $ADDR |
557 | SV = NULL\\(0x0\\) at $ADDR |
558 | REFCNT = \d+ |
559 | FLAGS = \\(READONLY\\) |
560 | PV = $ADDR "" |
561 | CUR = 0 |
562 | LEN = 0 |
563 | STASH = $ADDR\s+"Foobar"'); |
b1886099 |
564 | |
565 | # Constant subroutines |
566 | |
567 | sub const () { |
568 | "Perl rules"; |
569 | } |
570 | |
571 | do_test(23, |
572 | \&const, |
4df7f6af |
573 | 'SV = $RV\\($ADDR\\) at $ADDR |
b1886099 |
574 | REFCNT = 1 |
575 | FLAGS = \\(ROK\\) |
576 | RV = $ADDR |
577 | SV = PVCV\\($ADDR\\) at $ADDR |
578 | REFCNT = (2) |
579 | FLAGS = \\(POK,pPOK,CONST\\) |
c84c4652 |
580 | $IVNV |
b1886099 |
581 | PROTOTYPE = "" |
582 | COMP_STASH = 0x0 |
d04ba589 |
583 | $ROOT |
b1886099 |
584 | XSUB = $ADDR |
585 | XSUBANY = $ADDR \\(CONST SV\\) |
586 | SV = PV\\($ADDR\\) at $ADDR |
587 | REFCNT = 1 |
588 | FLAGS = \\(.*POK,READONLY,pPOK\\) |
589 | PV = $ADDR "Perl rules"\\\0 |
590 | CUR = 10 |
591 | LEN = \\d+ |
592 | GVGV::GV = $ADDR\\t"main" :: "const" |
593 | FILE = ".*\\b(?i:peek\\.t)" |
000fd473 |
594 | DEPTH = 0(?: |
595 | MUTEXP = $ADDR |
596 | OWNER = $ADDR)? |
597 | FLAGS = 0x200 # $] < 5.009 |
598 | FLAGS = 0xc00 # $] >= 5.009 |
b1886099 |
599 | OUTSIDE_SEQ = 0 |
600 | PADLIST = 0x0 |
601 | OUTSIDE = 0x0 \\(null\\)'); |
2e94196c |
602 | |
603 | # isUV should show on PVMG |
604 | do_test(24, |
605 | do { my $v = $1; $v = ~0; $v }, |
606 | 'SV = PVMG\\($ADDR\\) at $ADDR |
607 | REFCNT = 1 |
608 | FLAGS = \\(IOK,pIOK,IsUV\\) |
609 | UV = \d+ |
610 | NV = 0 |
611 | PV = 0'); |
c0a413d1 |
612 | |
613 | do_test(25, |
614 | *STDOUT{IO}, |
615 | 'SV = $RV\\($ADDR\\) at $ADDR |
616 | REFCNT = 1 |
617 | FLAGS = \\(ROK\\) |
618 | RV = $ADDR |
619 | SV = PVIO\\($ADDR\\) at $ADDR |
620 | REFCNT = 3 |
621 | FLAGS = \\(OBJECT\\) |
622 | IV = 0 |
623 | $NV |
624 | STASH = $ADDR\s+"IO::Handle" |
625 | IFP = $ADDR |
626 | OFP = $ADDR |
627 | DIRP = 0x0 |
628 | LINES = 0 |
629 | PAGE = 0 |
630 | PAGE_LEN = 60 |
631 | LINES_LEFT = 0 |
632 | TOP_GV = 0x0 |
633 | FMT_GV = 0x0 |
634 | BOTTOM_GV = 0x0 |
98deaf8b |
635 | $SUBPROCESS |
c0a413d1 |
636 | TYPE = \'>\' |
637 | FLAGS = 0x0'); |