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