This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Split out study magic from pos magic.
[perl5.git] / ext / Devel-Peek / t / Peek.t
CommitLineData
99331854 1#!./perl -T
9ec58fb7
JH		 2
3BEGIN {
9ec58fb7 4 require Config; import Config;
e7ecf62c 5 if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) {
9ec58fb7
JH		 6 print "1..0 # Skip: Devel::Peek was not built\n";
7 exit 0;
8 }
9}
10
06a5cade 11use Test::More;
e7ecf62c 12
9248c45a
JH		 13use Devel::Peek;
14
9248c45a 15our $DEBUG = 0;
277ddfaf 16open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
9248c45a 17
bfe27a58
NC		 18# If I reference any lexicals in this, I get the entire outer subroutine (or
19# MAIN) dumped too, which isn't really what I want, as it's a lot of faff to
20# maintain that.
21format PIE =
22Pie @<<<<<
23$::type
24Good @>>>>>
25$::mmmm
26.
27
9248c45a 28sub do_test {
000fd473
NC		 29 my $todo = $_[3];
30 my $repeat_todo = $_[4];
31 my $pattern = $_[2];
277ddfaf
GS		 32 if (open(OUT,">peek$$")) {
33 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
9248c45a 34 Dump($_[1]);
e9569a7a
GG		 35 print STDERR "*****\n";
36 Dump($_[1]); # second dump to compare with the first to make sure nothing changed.
277ddfaf
GS		 37 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
38 close(OUT);
9248c45a
JH		 39 if (open(IN, "peek$$")) {
40 local $/;
41 $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
8aacddc1 42 $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
fd0854ff 43 # handle DEBUG_LEAKING_SCALARS prefix
d94a5950 44 $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
bf53b3a5 45
000fd473
NC		 46 # Need some clear generic mechanism to eliminate (or add) lines
47 # of dump output dependant on perl version. The (previous) use of
48 # things like $IVNV gave the illusion that the string passed in was
49 # a regexp into which variables were interpolated, but this wasn't
50 # actually true as those 'variables' actually also ate the
b7b1e41b 51 # whitespace on the line. So it seems better to mark lines that
000fd473
NC		 52 # need to be eliminated. I considered (?# ... ) and (?{ ... }),
53 # but whilst embedded code or comment syntax would keep it as a
54 # legitimate regexp, it still isn't true. Seems easier and clearer
55 # things that look like comments.
56
c2485e0c 57 my $version_condition = qr/\$] [<>]=? 5\.\d\d\d/;
000fd473
NC		 58 # Could do this is in a s///mge but seems clearer like this:
59 $pattern = join '', map {
60 # If we identify the version condition, take *it* out whatever
c2485e0c 61 s/\s*# ($version_condition(?: && $version_condition)?)$//
000fd473
NC		 62 ? (eval $1 ? $_ : '')
63 : $_ # Didn't match, so this line is in
64 } split /^/, $pattern;
65
66 $pattern =~ s/\$PADMY/
67 ($] < 5.009) ? 'PADBUSY,PADMY' : 'PADMY';
68 /mge;
69 $pattern =~ s/\$PADTMP/
70 ($] < 5.009) ? 'PADBUSY,PADTMP' : 'PADTMP';
71 /mge;
2b631c93
NC		 72 $pattern =~ s/\$RV/
73 ($] < 5.011) ? 'RV' : 'IV';
74 /mge;
d04ba589 75
9248c45a 76 print $pattern, "\n" if $DEBUG;
e9569a7a 77 my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
9248c45a 78 print $dump, "\n" if $DEBUG;
06a5cade
NC		 79 like( $dump, qr/\A$pattern\Z/ms, $_[0])
80 or note("line " . (caller)[2]);
e9569a7a 81
000fd473 82 local $TODO = $repeat_todo;
06a5cade
NC		 83 is($dump2, $dump, "$_[0] (unchanged by dump)")
84 or note("line " . (caller)[2]);
e9569a7a 85
9248c45a 86 close(IN);
e9569a7a 87
59d8ce62 88 return $1;
9248c45a
JH		 89 } else {
90 die "$0: failed to open peek$$: !\n";
91 }
92 } else {
93 die "$0: failed to create peek$$: $!\n";
94 }
95}
96
97our $a;
98our $b;
99my $c;
208edb77 100local $d = 0;
9248c45a 101
e7ecf62c
RGS		 102END {
103 1 while unlink("peek$$");
104}
bf53b3a5 105
06a5cade 106do_test('assignment of immediate constant (string)',
9248c45a
JH		 107 $a = "foo",
108'SV = PV\\($ADDR\\) at $ADDR
109 REFCNT = 1
110 FLAGS = \\(POK,pPOK\\)
111 PV = $ADDR "foo"\\\0
112 CUR = 3
1badabf5 113 LEN = \\d+'
9248c45a
JH		 114 );
115
06a5cade 116do_test('immediate constant (string)',
9248c45a
JH		 117 "bar",
118'SV = PV\\($ADDR\\) at $ADDR
119 REFCNT = 1
7766e686 120 FLAGS = \\(.*POK,READONLY,pPOK\\)
9248c45a
JH		 121 PV = $ADDR "bar"\\\0
122 CUR = 3
1badabf5 123 LEN = \\d+');
9248c45a 124
b7b1e41b 125do_test('assignment of immediate constant (integer)',
9248c45a
JH		 126 $b = 123,
127'SV = IV\\($ADDR\\) at $ADDR
128 REFCNT = 1
129 FLAGS = \\(IOK,pIOK\\)
130 IV = 123');
131
06a5cade 132do_test('immediate constant (integer)',
9248c45a
JH		 133 456,
134'SV = IV\\($ADDR\\) at $ADDR
135 REFCNT = 1
7766e686 136 FLAGS = \\(.*IOK,READONLY,pIOK\\)
9248c45a
JH		 137 IV = 456');
138
06a5cade 139do_test('assignment of immediate constant (integer)',
9248c45a
JH		 140 $c = 456,
141'SV = IV\\($ADDR\\) at $ADDR
142 REFCNT = 1
000fd473 143 FLAGS = \\($PADMY,IOK,pIOK\\)
9248c45a
JH		 144 IV = 456');
145
59d8ce62
NC		 146# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
147# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
148# maths is done in floating point always, and this scalar will be an NV.
149# ([NI]) captures the type, referred to by \1 in this regexp and $type for
150# building subsequent regexps.
06a5cade 151my $type = do_test('result of addition',
9248c45a 152 $c + $d,
59d8ce62 153'SV = ([NI])V\\($ADDR\\) at $ADDR
9248c45a 154 REFCNT = 1
59d8ce62
NC		 155 FLAGS = \\(PADTMP,\1OK,p\1OK\\)
156 \1V = 456');
9248c45a
JH		 157
158($d = "789") += 0.1;
159
06a5cade 160do_test('floating point value',
9248c45a
JH		 161 $d,
162'SV = PVNV\\($ADDR\\) at $ADDR
163 REFCNT = 1
164 FLAGS = \\(NOK,pNOK\\)
78d00c47 165 IV = \d+
ac634a9a 166 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
9248c45a
JH		 167 PV = $ADDR "789"\\\0
168 CUR = 3
1badabf5 169 LEN = \\d+');
9248c45a 170
06a5cade 171do_test('integer constant',
9248c45a
JH		 172 0xabcd,
173'SV = IV\\($ADDR\\) at $ADDR
174 REFCNT = 1
28e5dec8
JH		 175 FLAGS = \\(.*IOK,READONLY,pIOK\\)
176 IV = 43981');
9248c45a 177
06a5cade 178do_test('undef',
9248c45a
JH		 179 undef,
180'SV = NULL\\(0x0\\) at $ADDR
181 REFCNT = 1
182 FLAGS = \\(\\)');
183
06a5cade 184do_test('reference to scalar',
9248c45a 185 \$a,
4df7f6af 186'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH		 187 REFCNT = 1
188 FLAGS = \\(ROK\\)
189 RV = $ADDR
190 SV = PV\\($ADDR\\) at $ADDR
191 REFCNT = 2
192 FLAGS = \\(POK,pPOK\\)
193 PV = $ADDR "foo"\\\0
194 CUR = 3
1badabf5 195 LEN = \\d+');
9248c45a 196
59d8ce62
NC		 197my $c_pattern;
198if ($type eq 'N') {
199 $c_pattern = '
200 SV = PVNV\\($ADDR\\) at $ADDR
201 REFCNT = 1
202 FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
203 IV = 456
204 NV = 456
205 PV = 0';
206} else {
207 $c_pattern = '
208 SV = IV\\($ADDR\\) at $ADDR
209 REFCNT = 1
210 FLAGS = \\(IOK,pIOK\\)
211 IV = 456';
212}
06a5cade 213do_test('reference to array',
9248c45a 214 [$b,$c],
4df7f6af 215'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH		 216 REFCNT = 1
217 FLAGS = \\(ROK\\)
218 RV = $ADDR
219 SV = PVAV\\($ADDR\\) at $ADDR
78c72037 220 REFCNT = 1
9248c45a 221 FLAGS = \\(\\)
1bcecb77
NC		 222 IV = 0 # $] < 5.009
223 NV = 0 # $] < 5.009
9248c45a
JH		 224 ARRAY = $ADDR
225 FILL = 1
226 MAX = 1
227 ARYLEN = 0x0
228 FLAGS = \\(REAL\\)
229 Elt No. 0
230 SV = IV\\($ADDR\\) at $ADDR
231 REFCNT = 1
232 FLAGS = \\(IOK,pIOK\\)
233 IV = 123
59d8ce62 234 Elt No. 1' . $c_pattern);
9248c45a 235
06a5cade 236do_test('reference to hash',
9248c45a 237 {$b=>$c},
4df7f6af 238'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH		 239 REFCNT = 1
240 FLAGS = \\(ROK\\)
241 RV = $ADDR
242 SV = PVHV\\($ADDR\\) at $ADDR
78c72037 243 REFCNT = 1
9248c45a 244 FLAGS = \\(SHAREKEYS\\)
1bcecb77
NC		 245 IV = 1 # $] < 5.009
246 NV = $FLOAT # $] < 5.009
9248c45a 247 ARRAY = $ADDR \\(0:7, 1:1\\)
b8fa94d8 248 hash quality = 100.0%
9248c45a
JH		 249 KEYS = 1
250 FILL = 1
251 MAX = 7
252 RITER = -1
253 EITER = 0x0
000fd473
NC		 254 Elt "123" HASH = $ADDR' . $c_pattern,
255 '',
f3ce8053
FC		 256 $] > 5.009 && $] < 5.015
257 && 'The hash iterator used in dump.c sets the OOK flag');
9248c45a 258
06a5cade 259do_test('reference to anon sub with empty prototype',
9248c45a 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
cfc1e951 267 FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC\\)
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 281 FLAGS = 0x404 # $] < 5.009
cfc1e951 282 FLAGS = 0x490 # $] >= 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
06a5cade 288do_test('reference to named subroutine without prototype',
9248c45a 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"
c2485e0c 316 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$version_condition"
000fd473
NC		 317 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" # $] < 5.009
318 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 # $] >= 5.009
ee6cee0c 319 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
e9569a7a 320 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2"
9248c45a
JH		 321 OUTSIDE = $ADDR \\(MAIN\\)');
322
3ce3ed55 323if ($] >= 5.011) {
06a5cade 324do_test('reference to regexp',
3ce3ed55
NC		 325 qr(tic),
326'SV = $RV\\($ADDR\\) at $ADDR
327 REFCNT = 1
328 FLAGS = \\(ROK\\)
329 RV = $ADDR
5c35adbb 330 SV = REGEXP\\($ADDR\\) at $ADDR
c2123ae3 331 REFCNT = 1
b9ad13ac 332 FLAGS = \\(OBJECT,POK,FAKE,pPOK\\)
fb85c044
KW		 333 PV = $ADDR "\\(\\?\\^:tic\\)"
334 CUR = 8
c2123ae3 335 LEN = 0
d63e6659
DM		 336 STASH = $ADDR\\t"Regexp"'
337. ($] < 5.013 ? '' :
338'
339 EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
340 INTFLAGS = 0x0
341 NPARENS = 0
342 LASTPAREN = 0
343 LASTCLOSEPAREN = 0
344 MINLEN = 3
345 MINLENRET = 3
346 GOFS = 0
347 PRE_PREFIX = 4
348 SEEN_EVALS = 0
349 SUBLEN = 0
350 SUBBEG = 0x0
351 ENGINE = $ADDR
352 MOTHER_RE = $ADDR
353 PAREN_NAMES = 0x0
354 SUBSTRS = $ADDR
355 PPRIVATE = $ADDR
356 OFFS = $ADDR'
357));
3ce3ed55 358} else {
06a5cade 359do_test('reference to regexp',
9248c45a 360 qr(tic),
4df7f6af 361'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH		 362 REFCNT = 1
363 FLAGS = \\(ROK\\)
364 RV = $ADDR
365 SV = PVMG\\($ADDR\\) at $ADDR
366 REFCNT = 1
faf82a0b 367 FLAGS = \\(OBJECT,SMG\\)
9248c45a
JH		 368 IV = 0
369 NV = 0
370 PV = 0
371 MAGIC = $ADDR
372 MG_VIRTUAL = $ADDR
14befaf4 373 MG_TYPE = PERL_MAGIC_qr\(r\)
9248c45a 374 MG_OBJ = $ADDR
fb85c044 375 PAT = "\(\?^:tic\)" # $] >= 5.009
1bcecb77 376 REFCNT = 2 # $] >= 5.009
9248c45a 377 STASH = $ADDR\\t"Regexp"');
3ce3ed55 378}
9248c45a 379
06a5cade 380do_test('reference to blessed hash',
9248c45a 381 (bless {}, "Tac"),
4df7f6af 382'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH		 383 REFCNT = 1
384 FLAGS = \\(ROK\\)
385 RV = $ADDR
386 SV = PVHV\\($ADDR\\) at $ADDR
78c72037 387 REFCNT = 1
9248c45a 388 FLAGS = \\(OBJECT,SHAREKEYS\\)
1bcecb77
NC		 389 IV = 0 # $] < 5.009
390 NV = 0 # $] < 5.009
9248c45a
JH		 391 STASH = $ADDR\\t"Tac"
392 ARRAY = 0x0
393 KEYS = 0
394 FILL = 0
395 MAX = 7
396 RITER = -1
000fd473 397 EITER = 0x0', '',
f3ce8053
FC		 398 $] > 5.009
399 ? $] >= 5.015
400 ? 0
401 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 402 : "Something causes the HV's array to become allocated");
9248c45a 403
06a5cade 404do_test('typeglob',
9248c45a
JH		 405 *a,
406'SV = PVGV\\($ADDR\\) at $ADDR
407 REFCNT = 5
000fd473
NC		 408 FLAGS = \\(MULTI(?:,IN_PAD)?\\) # $] >= 5.009
409 FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\) # $] < 5.009
410 IV = 0 # $] < 5.009
411 NV = 0 # $] < 5.009
412 PV = 0 # $] < 5.009
413 MAGIC = $ADDR # $] < 5.009
414 MG_VIRTUAL = &PL_vtbl_glob # $] < 5.009
415 MG_TYPE = PERL_MAGIC_glob\(\*\) # $] < 5.009
416 MG_OBJ = $ADDR # $] < 5.009
9248c45a
JH		 417 NAME = "a"
418 NAMELEN = 1
419 GvSTASH = $ADDR\\t"main"
420 GP = $ADDR
421 SV = $ADDR
422 REFCNT = 1
423 IO = 0x0
424 FORM = 0x0
425 AV = 0x0
426 HV = 0x0
427 CV = 0x0
428 CVGEN = 0x0
000fd473 429 GPFLAGS = 0x0 # $] < 5.009
9ec58fb7 430 LINE = \\d+
084d946d 431 FILE = ".*\\b(?i:peek\\.t)"
e39917cc 432 FLAGS = $ADDR
9248c45a
JH		 433 EGV = $ADDR\\t"a"');
434
cdb2dd7b 435if (ord('A') == 193) {
06a5cade 436do_test('string with Unicode',
cdb2dd7b
JH		 437 chr(256).chr(0).chr(512),
438'SV = PV\\($ADDR\\) at $ADDR
439 REFCNT = 1
000fd473 440 FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)
cdb2dd7b
JH		 441 PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
442 CUR = 5
1badabf5 443 LEN = \\d+');
cdb2dd7b 444} else {
06a5cade 445do_test('string with Unicode',
e6abe6d8
JH		 446 chr(256).chr(0).chr(512),
447'SV = PV\\($ADDR\\) at $ADDR
448 REFCNT = 1
000fd473 449 FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)
98c991d1 450 PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
e6abe6d8 451 CUR = 5
1badabf5 452 LEN = \\d+');
cdb2dd7b 453}
e6abe6d8 454
cdb2dd7b 455if (ord('A') == 193) {
06a5cade 456do_test('reference to hash containing Unicode',
cdb2dd7b 457 {chr(256)=>chr(512)},
4df7f6af 458'SV = $RV\\($ADDR\\) at $ADDR
cdb2dd7b
JH		 459 REFCNT = 1
460 FLAGS = \\(ROK\\)
461 RV = $ADDR
462 SV = PVHV\\($ADDR\\) at $ADDR
78c72037 463 REFCNT = 1
b2caaddd 464 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1bcecb77
NC		 465 UV = 1 # $] < 5.009
466 NV = $FLOAT # $] < 5.009
cdb2dd7b
JH		 467 ARRAY = $ADDR \\(0:7, 1:1\\)
468 hash quality = 100.0%
469 KEYS = 1
470 FILL = 1
471 MAX = 7
472 RITER = -1
473 EITER = $ADDR
6cbfa5b4 474 Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
cdb2dd7b
JH		 475 SV = PV\\($ADDR\\) at $ADDR
476 REFCNT = 1
477 FLAGS = \\(POK,pPOK,UTF8\\)
478 PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
479 CUR = 2
000fd473 480 LEN = \\d+',
f3ce8053
FC		 481 $] > 5.009
482 ? $] >= 5.015
483 ? 0
484 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 485 : 'sv_length has been called on the element, and cached the result in MAGIC');
cdb2dd7b 486} else {
06a5cade 487do_test('reference to hash containing Unicode',
98c991d1 488 {chr(256)=>chr(512)},
4df7f6af 489'SV = $RV\\($ADDR\\) at $ADDR
98c991d1
JH		 490 REFCNT = 1
491 FLAGS = \\(ROK\\)
492 RV = $ADDR
493 SV = PVHV\\($ADDR\\) at $ADDR
78c72037 494 REFCNT = 1
19692e8d 495 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1bcecb77
NC		 496 UV = 1 # $] < 5.009
497 NV = 0 # $] < 5.009
98c991d1
JH		 498 ARRAY = $ADDR \\(0:7, 1:1\\)
499 hash quality = 100.0%
500 KEYS = 1
501 FILL = 1
502 MAX = 7
503 RITER = -1
504 EITER = $ADDR
505 Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
506 SV = PV\\($ADDR\\) at $ADDR
507 REFCNT = 1
508 FLAGS = \\(POK,pPOK,UTF8\\)
509 PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
510 CUR = 2
000fd473 511 LEN = \\d+', '',
f3ce8053
FC		 512 $] > 5.009
513 ? $] >= 5.015
514 ? 0
515 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 516 : 'sv_length has been called on the element, and cached the result in MAGIC');
cdb2dd7b 517}
98c991d1 518
99331854
YST		 519my $x="";
520$x=~/.??/g;
06a5cade 521do_test('scalar with pos magic',
99331854
YST		 522 $x,
523'SV = PVMG\\($ADDR\\) at $ADDR
524 REFCNT = 1
000fd473 525 FLAGS = \\($PADMY,SMG,POK,pPOK\\)
99331854
YST		 526 IV = 0
527 NV = 0
528 PV = $ADDR ""\\\0
529 CUR = 0
1936d2a7 530 LEN = \d+
99331854
YST		 531 MAGIC = $ADDR
532 MG_VIRTUAL = &PL_vtbl_mglob
533 MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
534 MG_FLAGS = 0x01
535 MINMATCH');
536
f24fdb76
HS		 537#
538# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
539# environment variables may be invisibly case-forced, hence the (?i:PATH)
5e836f43 540# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
d9baf692
JM		 541# VMS is setting FAKE and READONLY flags. What VMS uses for storing
542# ENV hashes is also not always null terminated.
f24fdb76 543#
06a5cade 544do_test('tainted value in %ENV',
99331854
YST		 545 $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
546'SV = PVMG\\($ADDR\\) at $ADDR
547 REFCNT = 1
548 FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
549 IV = 0
550 NV = 0
551 PV = $ADDR "0"\\\0
552 CUR = 1
553 LEN = \d+
554 MAGIC = $ADDR
555 MG_VIRTUAL = &PL_vtbl_envelem
556 MG_TYPE = PERL_MAGIC_envelem\\(e\\)
d25a523c 557(?: MG_FLAGS = 0x01
99331854 558 TAINTEDDIR
143a3e5e
CB		 559)? MG_LEN = -?\d+
560 MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
5e836f43 561 SV = PV(?:IV)?\\($ADDR\\) at $ADDR
143a3e5e 562 REFCNT = \d+
11e2783c 563 FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
f0fabfd7 564(?: IV = 0
d9baf692 565)? PV = $ADDR "(?i:PATH)"(?:\\\0)?
143a3e5e
CB		 566 CUR = \d+
567 LEN = \d+)
99331854
YST		 568 MAGIC = $ADDR
569 MG_VIRTUAL = &PL_vtbl_taint
570 MG_TYPE = PERL_MAGIC_taint\\(t\\)');
571
06a5cade 572do_test('blessed reference',
6bf47b08 573 bless(\\undef, 'Foobar'),
4df7f6af 574'SV = $RV\\($ADDR\\) at $ADDR
6bf47b08
SR		 575 REFCNT = 1
576 FLAGS = \\(ROK\\)
577 RV = $ADDR
578 SV = PVMG\\($ADDR\\) at $ADDR
579 REFCNT = 2
580 FLAGS = \\(OBJECT,ROK\\)
7957ad98
MB		 581 IV = -?\d+
582 NV = $FLOAT
6bf47b08
SR		 583 RV = $ADDR
584 SV = NULL\\(0x0\\) at $ADDR
585 REFCNT = \d+
586 FLAGS = \\(READONLY\\)
587 PV = $ADDR ""
588 CUR = 0
589 LEN = 0
590 STASH = $ADDR\s+"Foobar"');
b1886099 591
b1886099
NC		 592sub const () {
593 "Perl rules";
594}
595
06a5cade 596do_test('constant subroutine',
b1886099 597 \&const,
4df7f6af 598'SV = $RV\\($ADDR\\) at $ADDR
b1886099
NC		 599 REFCNT = 1
600 FLAGS = \\(ROK\\)
601 RV = $ADDR
602 SV = PVCV\\($ADDR\\) at $ADDR
603 REFCNT = (2)
31d45e0c 604 FLAGS = \\(POK,pPOK,CONST,ISXSUB\\)
1bcecb77
NC		 605 IV = 0 # $] < 5.009
606 NV = 0 # $] < 5.009
b1886099
NC		 607 PROTOTYPE = ""
608 COMP_STASH = 0x0
1bcecb77 609 ROOT = 0x0 # $] < 5.009
b1886099
NC		 610 XSUB = $ADDR
611 XSUBANY = $ADDR \\(CONST SV\\)
612 SV = PV\\($ADDR\\) at $ADDR
613 REFCNT = 1
614 FLAGS = \\(.*POK,READONLY,pPOK\\)
615 PV = $ADDR "Perl rules"\\\0
616 CUR = 10
617 LEN = \\d+
618 GVGV::GV = $ADDR\\t"main" :: "const"
619 FILE = ".*\\b(?i:peek\\.t)"
000fd473
NC		 620 DEPTH = 0(?:
621 MUTEXP = $ADDR
622 OWNER = $ADDR)?
1bcecb77 623 FLAGS = 0x200 # $] < 5.009
c2485e0c
NC		 624 FLAGS = 0xc00 # $] >= 5.009 && $] < 5.013
625 FLAGS = 0xc # $] >= 5.013
b1886099
NC		 626 OUTSIDE_SEQ = 0
627 PADLIST = 0x0
628 OUTSIDE = 0x0 \\(null\\)');
2e94196c 629
06a5cade 630do_test('isUV should show on PVMG',
2e94196c
NC		 631 do { my $v = $1; $v = ~0; $v },
632'SV = PVMG\\($ADDR\\) at $ADDR
633 REFCNT = 1
634 FLAGS = \\(IOK,pIOK,IsUV\\)
635 UV = \d+
636 NV = 0
637 PV = 0');
c0a413d1 638
06a5cade 639do_test('IO',
c0a413d1
NC		 640 *STDOUT{IO},
641'SV = $RV\\($ADDR\\) at $ADDR
642 REFCNT = 1
643 FLAGS = \\(ROK\\)
644 RV = $ADDR
645 SV = PVIO\\($ADDR\\) at $ADDR
646 REFCNT = 3
647 FLAGS = \\(OBJECT\\)
3cf51070 648 IV = 0 # $] < 5.011
1bcecb77 649 NV = 0 # $] < 5.011
d963bf01 650 STASH = $ADDR\s+"IO::File"
c0a413d1
NC		 651 IFP = $ADDR
652 OFP = $ADDR
653 DIRP = 0x0
654 LINES = 0
655 PAGE = 0
656 PAGE_LEN = 60
657 LINES_LEFT = 0
658 TOP_GV = 0x0
659 FMT_GV = 0x0
660 BOTTOM_GV = 0x0
1bcecb77 661 SUBPROCESS = 0 # $] < 5.009
c0a413d1 662 TYPE = \'>\'
50a9fad1 663 FLAGS = 0x4');
bfe27a58 664
06a5cade 665do_test('FORMAT',
bfe27a58
NC		 666 *PIE{FORMAT},
667'SV = $RV\\($ADDR\\) at $ADDR
668 REFCNT = 1
669 FLAGS = \\(ROK\\)
670 RV = $ADDR
671 SV = PVFM\\($ADDR\\) at $ADDR
672 REFCNT = 2
673 FLAGS = \\(\\)
30ec677d 674 IV = 0 # $] < 5.009
bfe27a58 675 NV = 0 # $] < 5.009
251a4af1
DM		 676(?: PV = 0
677)? COMP_STASH = 0x0
bfe27a58
NC		 678 START = $ADDR ===> \\d+
679 ROOT = $ADDR
680 XSUB = 0x0 # $] < 5.009
681 XSUBANY = 0 # $] < 5.009
682 GVGV::GV = $ADDR\\t"main" :: "PIE"
683 FILE = ".*\\b(?i:peek\\.t)"
c12100a4
DM		 684(?: DEPTH = 0
685 MUTEXP = $ADDR
bfe27a58
NC		 686 OWNER = $ADDR
687)? FLAGS = 0x0
688 OUTSIDE_SEQ = \\d+
689 LINES = 0
690 PADLIST = $ADDR
691 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
692 OUTSIDE = $ADDR \\(MAIN\\)');
d7d51f4b 693
b7b1e41b 694do_test('blessing to a class with embedded NUL characters',
d7d51f4b
YO		 695 (bless {}, "\0::foo::\n::baz::\t::\0"),
696'SV = $RV\\($ADDR\\) at $ADDR
697 REFCNT = 1
698 FLAGS = \\(ROK\\)
699 RV = $ADDR
700 SV = PVHV\\($ADDR\\) at $ADDR
701 REFCNT = 1
702 FLAGS = \\(OBJECT,SHAREKEYS\\)
703 IV = 0 # $] < 5.009
704 NV = 0 # $] < 5.009
705 STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0"
706 ARRAY = $ADDR
707 KEYS = 0
708 FILL = 0
709 MAX = 7
710 RITER = -1
711 EITER = 0x0', '',
f3ce8053
FC		 712 $] > 5.009
713 ? $] >= 5.015
714 ? 0
715 : 'The hash iterator used in dump.c sets the OOK flag'
d7d51f4b
YO		 716 : "Something causes the HV's array to become allocated");
717
bed53064
NC		 718do_test('ENAME on a stash',
719 \%RWOM::,
720'SV = $RV\\($ADDR\\) at $ADDR
721 REFCNT = 1
722 FLAGS = \\(ROK\\)
723 RV = $ADDR
724 SV = PVHV\\($ADDR\\) at $ADDR
725 REFCNT = 2
726 FLAGS = \\(OOK,SHAREKEYS\\)
727 IV = 1 # $] < 5.009
728 NV = $FLOAT # $] < 5.009
729 ARRAY = $ADDR
730 KEYS = 0
731 FILL = 0
732 MAX = 7
733 RITER = -1
734 EITER = 0x0
735 NAME = "RWOM"
736 ENAME = "RWOM" # $] > 5.012
737');
738
739*KLANK:: = \%RWOM::;
740
741do_test('ENAMEs on a stash',
742 \%RWOM::,
743'SV = $RV\\($ADDR\\) at $ADDR
744 REFCNT = 1
745 FLAGS = \\(ROK\\)
746 RV = $ADDR
747 SV = PVHV\\($ADDR\\) at $ADDR
748 REFCNT = 3
749 FLAGS = \\(OOK,SHAREKEYS\\)
750 IV = 1 # $] < 5.009
751 NV = $FLOAT # $] < 5.009
752 ARRAY = $ADDR
753 KEYS = 0
754 FILL = 0
755 MAX = 7
756 RITER = -1
757 EITER = 0x0
758 NAME = "RWOM"
759 NAMECOUNT = 2 # $] > 5.012
760 ENAME = "RWOM", "KLANK" # $] > 5.012
761');
762
763undef %RWOM::;
764
765do_test('ENAMEs on a stash with no NAME',
766 \%RWOM::,
767'SV = $RV\\($ADDR\\) at $ADDR
768 REFCNT = 1
769 FLAGS = \\(ROK\\)
770 RV = $ADDR
771 SV = PVHV\\($ADDR\\) at $ADDR
772 REFCNT = 3
773 FLAGS = \\(OOK,SHAREKEYS\\)
774 IV = 1 # $] < 5.009
775 NV = $FLOAT # $] < 5.009
776 ARRAY = $ADDR
777 KEYS = 0
778 FILL = 0
779 MAX = 7
780 RITER = -1
781 EITER = 0x0
782 NAMECOUNT = -3 # $] > 5.012
783 ENAME = "RWOM", "KLANK" # $] > 5.012
784');
785
4ab5bd5f
FC		 786SKIP: {
787 skip "Not built with usemymalloc", 1
788 unless $Config{usemymalloc} eq 'y';
789 my $x = __PACKAGE__;
790 ok eval { fill_mstats($x); 1 }, 'fill_mstats on COW scalar'
791 or diag $@;
792}
793
bc9a5256
NC		 794# This is more a test of fbm_compile/pp_study (non) interaction than dumping
795# prowess, but short of duplicating all the gubbins of this file, I can't see
796# a way to make a better place for it:
797
ccbcbb3d
NC		 798use constant {
799 perl => 'rules',
800 beer => 'foamy',
801};
0a0c4b76
NC		 802
803unless ($Config{useithreads}) {
804 # These end up as copies in pads under ithreads, which rather defeats the
805 # the point of what we're trying to test here.
806
807 do_test('regular string constant', perl,
808'SV = PV\\($ADDR\\) at $ADDR
bc9a5256 809 REFCNT = 5
0a0c4b76
NC		 810 FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
811 PV = $ADDR "rules"\\\0
812 CUR = 5
813 LEN = \d+
814');
815
816 eval 'index "", perl';
817
818 # FIXME - really this shouldn't say EVALED. It's a false posistive on
819 # 0x40000000 being used for several things, not a flag for "I'm in a string
820 # eval"
821
822 do_test('string constant now an FBM', perl,
c13a5c80 823'SV = PVMG\\($ADDR\\) at $ADDR
bc9a5256
NC		 824 REFCNT = 5
825 FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
826 PV = $ADDR "rules"\\\0
827 CUR = 5
828 LEN = \d+
829 MAGIC = $ADDR
b76b0bf9 830 MG_VIRTUAL = &PL_vtbl_regexp
bc9a5256 831 MG_TYPE = PERL_MAGIC_bm\\(B\\)
2bda37ba
NC		 832 MG_LEN = 256
833 MG_PTR = $ADDR "(?:\\\\\d){256}"
bc9a5256
NC		 834 RARE = \d+
835 PREVIOUS = 1
836 USEFUL = 100
837');
838
839 is(study perl, '', "Not allowed to study an FBM");
840
841 do_test('string constant still an FBM', perl,
c13a5c80 842'SV = PVMG\\($ADDR\\) at $ADDR
bc9a5256 843 REFCNT = 5
0a0c4b76
NC		 844 FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
845 PV = $ADDR "rules"\\\0
846 CUR = 5
847 LEN = \d+
848 MAGIC = $ADDR
b76b0bf9 849 MG_VIRTUAL = &PL_vtbl_regexp
0a0c4b76 850 MG_TYPE = PERL_MAGIC_bm\\(B\\)
2bda37ba
NC		 851 MG_LEN = 256
852 MG_PTR = $ADDR "(?:\\\\\d){256}"
0a0c4b76
NC		 853 RARE = \d+
854 PREVIOUS = 1
855 USEFUL = 100
856');
ccbcbb3d
NC		 857
858 do_test('regular string constant', beer,
859'SV = PV\\($ADDR\\) at $ADDR
4265b45d 860 REFCNT = 5
ccbcbb3d
NC		 861 FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
862 PV = $ADDR "foamy"\\\0
863 CUR = 5
864 LEN = \d+
865');
866
867 is(study beer, 1, "Our studies were successful");
868
869 do_test('string constant now studied', beer,
870'SV = PVMG\\($ADDR\\) at $ADDR
4265b45d
NC		 871 REFCNT = 6
872 FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,SCREAM\\)
873 IV = 0
874 NV = 0
875 PV = $ADDR "foamy"\\\0
876 CUR = 5
877 LEN = \d+
878 MAGIC = $ADDR
0177730e
NC		 879 MG_VIRTUAL = &PL_vtbl_regexp
880 MG_TYPE = PERL_MAGIC_study\\(G\\)
4265b45d
NC		 881');
882
883 is (eval 'index "not too foamy", beer', 8, 'correct index');
884
885 do_test('string constant still studied', beer,
886'SV = PVMG\\($ADDR\\) at $ADDR
887 REFCNT = 6
ccbcbb3d
NC		 888 FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,SCREAM\\)
889 IV = 0
890 NV = 0
891 PV = $ADDR "foamy"\\\0
892 CUR = 5
893 LEN = \d+
894 MAGIC = $ADDR
0177730e
NC		 895 MG_VIRTUAL = &PL_vtbl_regexp
896 MG_TYPE = PERL_MAGIC_study\\(G\\)
ccbcbb3d 897');
0a0c4b76
NC		 898}
899
06a5cade 900done_testing();
Unnamed repository; edit this file 'description' to name the repository.