This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dump.c: Dump contents of regexps’ mother_re field
[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
bad4ae38
FC
28use constant thr => $Config{useithreads};
29
9248c45a 30sub do_test {
000fd473
NC
31 my $todo = $_[3];
32 my $repeat_todo = $_[4];
33 my $pattern = $_[2];
277ddfaf
GS
34 if (open(OUT,">peek$$")) {
35 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
9248c45a 36 Dump($_[1]);
e9569a7a
GG
37 print STDERR "*****\n";
38 Dump($_[1]); # second dump to compare with the first to make sure nothing changed.
277ddfaf
GS
39 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
40 close(OUT);
9248c45a
JH
41 if (open(IN, "peek$$")) {
42 local $/;
43 $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
8aacddc1 44 $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
fd0854ff 45 # handle DEBUG_LEAKING_SCALARS prefix
d94a5950 46 $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
bf53b3a5 47
000fd473
NC
48 # Need some clear generic mechanism to eliminate (or add) lines
49 # of dump output dependant on perl version. The (previous) use of
50 # things like $IVNV gave the illusion that the string passed in was
51 # a regexp into which variables were interpolated, but this wasn't
52 # actually true as those 'variables' actually also ate the
b7b1e41b 53 # whitespace on the line. So it seems better to mark lines that
000fd473
NC
54 # need to be eliminated. I considered (?# ... ) and (?{ ... }),
55 # but whilst embedded code or comment syntax would keep it as a
56 # legitimate regexp, it still isn't true. Seems easier and clearer
57 # things that look like comments.
58
59 # Could do this is in a s///mge but seems clearer like this:
60 $pattern = join '', map {
61 # If we identify the version condition, take *it* out whatever
bad4ae38 62 s/\s*# (\$].*)$//
000fd473
NC
63 ? (eval $1 ? $_ : '')
64 : $_ # Didn't match, so this line is in
65 } split /^/, $pattern;
66
67 $pattern =~ s/\$PADMY/
68 ($] < 5.009) ? 'PADBUSY,PADMY' : 'PADMY';
69 /mge;
70 $pattern =~ s/\$PADTMP/
71 ($] < 5.009) ? 'PADBUSY,PADTMP' : 'PADTMP';
72 /mge;
2b631c93
NC
73 $pattern =~ s/\$RV/
74 ($] < 5.011) ? 'RV' : 'IV';
75 /mge;
d04ba589 76
9248c45a 77 print $pattern, "\n" if $DEBUG;
e9569a7a 78 my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
9248c45a 79 print $dump, "\n" if $DEBUG;
06a5cade
NC
80 like( $dump, qr/\A$pattern\Z/ms, $_[0])
81 or note("line " . (caller)[2]);
e9569a7a 82
000fd473 83 local $TODO = $repeat_todo;
06a5cade
NC
84 is($dump2, $dump, "$_[0] (unchanged by dump)")
85 or note("line " . (caller)[2]);
e9569a7a 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
98our $a;
99our $b;
100my $c;
208edb77 101local $d = 0;
9248c45a 102
e7ecf62c
RGS
103END {
104 1 while unlink("peek$$");
105}
bf53b3a5 106
06a5cade 107do_test('assignment of immediate constant (string)',
9248c45a
JH
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
06a5cade 117do_test('immediate constant (string)',
9248c45a
JH
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 125
b7b1e41b 126do_test('assignment of immediate constant (integer)',
9248c45a
JH
127 $b = 123,
128'SV = IV\\($ADDR\\) at $ADDR
129 REFCNT = 1
130 FLAGS = \\(IOK,pIOK\\)
131 IV = 123');
132
06a5cade 133do_test('immediate constant (integer)',
9248c45a
JH
134 456,
135'SV = IV\\($ADDR\\) at $ADDR
136 REFCNT = 1
7766e686 137 FLAGS = \\(.*IOK,READONLY,pIOK\\)
9248c45a
JH
138 IV = 456');
139
06a5cade 140do_test('assignment of immediate constant (integer)',
9248c45a
JH
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.
06a5cade 152my $type = do_test('result of addition',
9248c45a 153 $c + $d,
59d8ce62 154'SV = ([NI])V\\($ADDR\\) at $ADDR
9248c45a 155 REFCNT = 1
f5b4a412
FC
156 FLAGS = \\(PADTMP,\1OK,p\1OK\\) # $] < 5.019003
157 FLAGS = \\(\1OK,p\1OK\\) # $] >=5.019003
59d8ce62 158 \1V = 456');
9248c45a
JH
159
160($d = "789") += 0.1;
161
06a5cade 162do_test('floating point value',
9248c45a
JH
163 $d,
164'SV = PVNV\\($ADDR\\) at $ADDR
165 REFCNT = 1
166 FLAGS = \\(NOK,pNOK\\)
78d00c47 167 IV = \d+
ac634a9a 168 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
9248c45a
JH
169 PV = $ADDR "789"\\\0
170 CUR = 3
1badabf5 171 LEN = \\d+');
9248c45a 172
06a5cade 173do_test('integer constant',
9248c45a
JH
174 0xabcd,
175'SV = IV\\($ADDR\\) at $ADDR
176 REFCNT = 1
28e5dec8
JH
177 FLAGS = \\(.*IOK,READONLY,pIOK\\)
178 IV = 43981');
9248c45a 179
06a5cade 180do_test('undef',
9248c45a
JH
181 undef,
182'SV = NULL\\(0x0\\) at $ADDR
183 REFCNT = 1
184 FLAGS = \\(\\)');
185
06a5cade 186do_test('reference to scalar',
9248c45a 187 \$a,
4df7f6af 188'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
189 REFCNT = 1
190 FLAGS = \\(ROK\\)
191 RV = $ADDR
192 SV = PV\\($ADDR\\) at $ADDR
193 REFCNT = 2
194 FLAGS = \\(POK,pPOK\\)
195 PV = $ADDR "foo"\\\0
196 CUR = 3
1badabf5 197 LEN = \\d+');
9248c45a 198
59d8ce62
NC
199my $c_pattern;
200if ($type eq 'N') {
201 $c_pattern = '
202 SV = PVNV\\($ADDR\\) at $ADDR
203 REFCNT = 1
204 FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
205 IV = 456
206 NV = 456
207 PV = 0';
208} else {
209 $c_pattern = '
210 SV = IV\\($ADDR\\) at $ADDR
211 REFCNT = 1
212 FLAGS = \\(IOK,pIOK\\)
213 IV = 456';
214}
06a5cade 215do_test('reference to array',
9248c45a 216 [$b,$c],
4df7f6af 217'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
218 REFCNT = 1
219 FLAGS = \\(ROK\\)
220 RV = $ADDR
221 SV = PVAV\\($ADDR\\) at $ADDR
78c72037 222 REFCNT = 1
9248c45a 223 FLAGS = \\(\\)
1bcecb77
NC
224 IV = 0 # $] < 5.009
225 NV = 0 # $] < 5.009
9248c45a
JH
226 ARRAY = $ADDR
227 FILL = 1
228 MAX = 1
229 ARYLEN = 0x0
230 FLAGS = \\(REAL\\)
231 Elt No. 0
232 SV = IV\\($ADDR\\) at $ADDR
233 REFCNT = 1
234 FLAGS = \\(IOK,pIOK\\)
235 IV = 123
59d8ce62 236 Elt No. 1' . $c_pattern);
9248c45a 237
06a5cade 238do_test('reference to hash',
9248c45a 239 {$b=>$c},
4df7f6af 240'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
241 REFCNT = 1
242 FLAGS = \\(ROK\\)
243 RV = $ADDR
244 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 245 REFCNT = [12]
9248c45a 246 FLAGS = \\(SHAREKEYS\\)
1bcecb77
NC
247 IV = 1 # $] < 5.009
248 NV = $FLOAT # $] < 5.009
9248c45a 249 ARRAY = $ADDR \\(0:7, 1:1\\)
b8fa94d8 250 hash quality = 100.0%
9248c45a
JH
251 KEYS = 1
252 FILL = 1
253 MAX = 7
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
bad4ae38
FC
267 FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC\\) # $] < 5.015 || !thr
268 FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC,DYNFILE\\) # $] >= 5.015 && thr
1bcecb77
NC
269 IV = 0 # $] < 5.009
270 NV = 0 # $] < 5.009
9248c45a
JH
271 PROTOTYPE = ""
272 COMP_STASH = $ADDR\\t"main"
273 START = $ADDR ===> \\d+
274 ROOT = $ADDR
1bcecb77
NC
275 XSUB = 0x0 # $] < 5.009
276 XSUBANY = 0 # $] < 5.009
208edb77 277 GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
084d946d 278 FILE = ".*\\b(?i:peek\\.t)"
000fd473
NC
279 DEPTH = 0(?:
280 MUTEXP = $ADDR
281 OWNER = $ADDR)?
1bcecb77 282 FLAGS = 0x404 # $] < 5.009
bad4ae38
FC
283 FLAGS = 0x490 # $] >= 5.009 && ($] < 5.015 || !thr)
284 FLAGS = 0x1490 # $] >= 5.015 && thr
a3985cdc 285 OUTSIDE_SEQ = \\d+
9248c45a 286 PADLIST = $ADDR
dd2155a4 287 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
9248c45a
JH
288 OUTSIDE = $ADDR \\(MAIN\\)');
289
06a5cade 290do_test('reference to named subroutine without prototype',
9248c45a 291 \&do_test,
4df7f6af 292'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
293 REFCNT = 1
294 FLAGS = \\(ROK\\)
295 RV = $ADDR
296 SV = PVCV\\($ADDR\\) at $ADDR
9856a127 297 REFCNT = (3|4)
2156df4b
FC
298 FLAGS = \\((?:HASEVAL)?\\) # $] < 5.015 || !thr
299 FLAGS = \\(DYNFILE(?:,HASEVAL)?\\) # $] >= 5.015 && thr
1bcecb77
NC
300 IV = 0 # $] < 5.009
301 NV = 0 # $] < 5.009
9248c45a
JH
302 COMP_STASH = $ADDR\\t"main"
303 START = $ADDR ===> \\d+
304 ROOT = $ADDR
1bcecb77
NC
305 XSUB = 0x0 # $] < 5.009
306 XSUBANY = 0 # $] < 5.009
9248c45a 307 GVGV::GV = $ADDR\\t"main" :: "do_test"
084d946d 308 FILE = ".*\\b(?i:peek\\.t)"
bad4ae38
FC
309 DEPTH = 1(?:
310 MUTEXP = $ADDR
311 OWNER = $ADDR)?
2156df4b
FC
312 FLAGS = 0x(?:400)?0 # $] < 5.015 || !thr
313 FLAGS = 0x[145]000 # $] >= 5.015 && thr
a3985cdc 314 OUTSIDE_SEQ = \\d+
9248c45a 315 PADLIST = $ADDR
dd2155a4 316 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
000fd473
NC
317 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$todo"
318 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$repeat_todo"
ee6cee0c 319 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
000fd473
NC
320 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" # $] < 5.009
321 \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 # $] >= 5.009
ee6cee0c 322 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
e9569a7a 323 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2"
9248c45a
JH
324 OUTSIDE = $ADDR \\(MAIN\\)');
325
3ce3ed55 326if ($] >= 5.011) {
06a5cade 327do_test('reference to regexp',
3ce3ed55
NC
328 qr(tic),
329'SV = $RV\\($ADDR\\) at $ADDR
330 REFCNT = 1
331 FLAGS = \\(ROK\\)
332 RV = $ADDR
5c35adbb 333 SV = REGEXP\\($ADDR\\) at $ADDR
c2123ae3 334 REFCNT = 1
8d919b0a
FC
335 FLAGS = \\(OBJECT,POK,FAKE,pPOK\\) # $] < 5.017006
336 FLAGS = \\(OBJECT,FAKE\\) # $] >= 5.017006
fb85c044
KW
337 PV = $ADDR "\\(\\?\\^:tic\\)"
338 CUR = 8
8d919b0a 339 LEN = 0 # $] < 5.017006
d63e6659
DM
340 STASH = $ADDR\\t"Regexp"'
341. ($] < 5.013 ? '' :
342'
dbc200c5 343 COMPFLAGS = 0x0 \(\)
d63e6659
DM
344 EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
345 INTFLAGS = 0x0
346 NPARENS = 0
347 LASTPAREN = 0
348 LASTCLOSEPAREN = 0
349 MINLEN = 3
350 MINLENRET = 3
351 GOFS = 0
352 PRE_PREFIX = 4
d63e6659 353 SUBLEN = 0
6502e081
DM
354 SUBOFFSET = 0
355 SUBCOFFSET = 0
d63e6659
DM
356 SUBBEG = 0x0
357 ENGINE = $ADDR
01ffd0f1
FC
358 MOTHER_RE = $ADDR'
359. ($] < 5.019003 ? '' : '
360 SV = REGEXP\($ADDR\) at $ADDR
361 REFCNT = 2
362 FLAGS = \(\)
363 PV = $ADDR "\(\?\^:tic\)"
364 CUR = 8
365 COMPFLAGS = 0x0 \(\)
366 EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
367 INTFLAGS = 0x0
368 NPARENS = 0
369 LASTPAREN = 0
370 LASTCLOSEPAREN = 0
371 MINLEN = 3
372 MINLENRET = 3
373 GOFS = 0
374 PRE_PREFIX = 4
375 SUBLEN = 0
376 SUBOFFSET = 0
377 SUBCOFFSET = 0
378 SUBBEG = 0x0
379 ENGINE = $ADDR
380 MOTHER_RE = 0x0
381 PAREN_NAMES = 0x0
382 SUBSTRS = $ADDR
383 PPRIVATE = $ADDR
384 OFFS = $ADDR
385 QR_ANONCV = 0x0(?:
386 SAVED_COPY = 0x0)?') . '
d63e6659
DM
387 PAREN_NAMES = 0x0
388 SUBSTRS = $ADDR
389 PPRIVATE = $ADDR
d63c20f2 390 OFFS = $ADDR
c9669de2
FC
391 QR_ANONCV = 0x0(?:
392 SAVED_COPY = 0x0)?'
d63e6659 393));
3ce3ed55 394} else {
06a5cade 395do_test('reference to regexp',
9248c45a 396 qr(tic),
4df7f6af 397'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
398 REFCNT = 1
399 FLAGS = \\(ROK\\)
400 RV = $ADDR
401 SV = PVMG\\($ADDR\\) at $ADDR
402 REFCNT = 1
faf82a0b 403 FLAGS = \\(OBJECT,SMG\\)
9248c45a
JH
404 IV = 0
405 NV = 0
406 PV = 0
407 MAGIC = $ADDR
408 MG_VIRTUAL = $ADDR
14befaf4 409 MG_TYPE = PERL_MAGIC_qr\(r\)
9248c45a 410 MG_OBJ = $ADDR
fb85c044 411 PAT = "\(\?^:tic\)" # $] >= 5.009
1bcecb77 412 REFCNT = 2 # $] >= 5.009
9248c45a 413 STASH = $ADDR\\t"Regexp"');
3ce3ed55 414}
9248c45a 415
06a5cade 416do_test('reference to blessed hash',
9248c45a 417 (bless {}, "Tac"),
4df7f6af 418'SV = $RV\\($ADDR\\) at $ADDR
9248c45a
JH
419 REFCNT = 1
420 FLAGS = \\(ROK\\)
421 RV = $ADDR
422 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 423 REFCNT = [12]
9248c45a 424 FLAGS = \\(OBJECT,SHAREKEYS\\)
1bcecb77
NC
425 IV = 0 # $] < 5.009
426 NV = 0 # $] < 5.009
9248c45a
JH
427 STASH = $ADDR\\t"Tac"
428 ARRAY = 0x0
429 KEYS = 0
430 FILL = 0
e1a7ec8d 431 MAX = 7', '',
f3ce8053
FC
432 $] > 5.009
433 ? $] >= 5.015
434 ? 0
435 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 436 : "Something causes the HV's array to become allocated");
9248c45a 437
06a5cade 438do_test('typeglob',
9248c45a
JH
439 *a,
440'SV = PVGV\\($ADDR\\) at $ADDR
441 REFCNT = 5
000fd473
NC
442 FLAGS = \\(MULTI(?:,IN_PAD)?\\) # $] >= 5.009
443 FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\) # $] < 5.009
444 IV = 0 # $] < 5.009
445 NV = 0 # $] < 5.009
446 PV = 0 # $] < 5.009
447 MAGIC = $ADDR # $] < 5.009
448 MG_VIRTUAL = &PL_vtbl_glob # $] < 5.009
449 MG_TYPE = PERL_MAGIC_glob\(\*\) # $] < 5.009
450 MG_OBJ = $ADDR # $] < 5.009
9248c45a
JH
451 NAME = "a"
452 NAMELEN = 1
453 GvSTASH = $ADDR\\t"main"
454 GP = $ADDR
455 SV = $ADDR
456 REFCNT = 1
457 IO = 0x0
458 FORM = 0x0
459 AV = 0x0
460 HV = 0x0
461 CV = 0x0
462 CVGEN = 0x0
000fd473 463 GPFLAGS = 0x0 # $] < 5.009
9ec58fb7 464 LINE = \\d+
084d946d 465 FILE = ".*\\b(?i:peek\\.t)"
e39917cc 466 FLAGS = $ADDR
9248c45a
JH
467 EGV = $ADDR\\t"a"');
468
cdb2dd7b 469if (ord('A') == 193) {
06a5cade 470do_test('string with Unicode',
cdb2dd7b
JH
471 chr(256).chr(0).chr(512),
472'SV = PV\\($ADDR\\) at $ADDR
473 REFCNT = 1
f5b4a412
FC
474 FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) # $] < 5.019003
475 FLAGS = \\((?:$PADTMP,)?POK,pPOK,UTF8\\) # $] >=5.019003
cdb2dd7b
JH
476 PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
477 CUR = 5
1badabf5 478 LEN = \\d+');
cdb2dd7b 479} else {
06a5cade 480do_test('string with Unicode',
e6abe6d8
JH
481 chr(256).chr(0).chr(512),
482'SV = PV\\($ADDR\\) at $ADDR
483 REFCNT = 1
f5b4a412
FC
484 FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) # $] < 5.019003
485 FLAGS = \\((?:$PADTMP,)?POK,pPOK,UTF8\\) # $] >=5.019003
98c991d1 486 PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
e6abe6d8 487 CUR = 5
1badabf5 488 LEN = \\d+');
cdb2dd7b 489}
e6abe6d8 490
cdb2dd7b 491if (ord('A') == 193) {
06a5cade 492do_test('reference to hash containing Unicode',
cdb2dd7b 493 {chr(256)=>chr(512)},
4df7f6af 494'SV = $RV\\($ADDR\\) at $ADDR
cdb2dd7b
JH
495 REFCNT = 1
496 FLAGS = \\(ROK\\)
497 RV = $ADDR
498 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 499 REFCNT = [12]
b2caaddd 500 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1bcecb77
NC
501 UV = 1 # $] < 5.009
502 NV = $FLOAT # $] < 5.009
cdb2dd7b
JH
503 ARRAY = $ADDR \\(0:7, 1:1\\)
504 hash quality = 100.0%
505 KEYS = 1
506 FILL = 1
507 MAX = 7
6cbfa5b4 508 Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
cdb2dd7b
JH
509 SV = PV\\($ADDR\\) at $ADDR
510 REFCNT = 1
511 FLAGS = \\(POK,pPOK,UTF8\\)
512 PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
513 CUR = 2
000fd473 514 LEN = \\d+',
f3ce8053
FC
515 $] > 5.009
516 ? $] >= 5.015
517 ? 0
518 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 519 : 'sv_length has been called on the element, and cached the result in MAGIC');
cdb2dd7b 520} else {
06a5cade 521do_test('reference to hash containing Unicode',
98c991d1 522 {chr(256)=>chr(512)},
4df7f6af 523'SV = $RV\\($ADDR\\) at $ADDR
98c991d1
JH
524 REFCNT = 1
525 FLAGS = \\(ROK\\)
526 RV = $ADDR
527 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 528 REFCNT = [12]
19692e8d 529 FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1bcecb77
NC
530 UV = 1 # $] < 5.009
531 NV = 0 # $] < 5.009
98c991d1
JH
532 ARRAY = $ADDR \\(0:7, 1:1\\)
533 hash quality = 100.0%
534 KEYS = 1
535 FILL = 1
536 MAX = 7
98c991d1
JH
537 Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
538 SV = PV\\($ADDR\\) at $ADDR
539 REFCNT = 1
540 FLAGS = \\(POK,pPOK,UTF8\\)
541 PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
542 CUR = 2
000fd473 543 LEN = \\d+', '',
f3ce8053
FC
544 $] > 5.009
545 ? $] >= 5.015
546 ? 0
547 : 'The hash iterator used in dump.c sets the OOK flag'
000fd473 548 : 'sv_length has been called on the element, and cached the result in MAGIC');
cdb2dd7b 549}
98c991d1 550
99331854
YST
551my $x="";
552$x=~/.??/g;
06a5cade 553do_test('scalar with pos magic',
99331854
YST
554 $x,
555'SV = PVMG\\($ADDR\\) at $ADDR
556 REFCNT = 1
c9669de2 557 FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?pPOK\\)
eed1f77c 558 IV = \d+
99331854
YST
559 NV = 0
560 PV = $ADDR ""\\\0
561 CUR = 0
c9669de2
FC
562 LEN = \d+(?:
563 COW_REFCNT = 1)?
99331854
YST
564 MAGIC = $ADDR
565 MG_VIRTUAL = &PL_vtbl_mglob
566 MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
567 MG_FLAGS = 0x01
568 MINMATCH');
569
f24fdb76
HS
570#
571# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
572# environment variables may be invisibly case-forced, hence the (?i:PATH)
5e836f43 573# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
12033064
CS
574# Perl 5.18 ensures all env vars end up as strings only, hence the (?:,pIOK)?
575# Perl 5.18 ensures even magic vars have public OK, hence the (?:,POK)?
d9baf692
JM
576# VMS is setting FAKE and READONLY flags. What VMS uses for storing
577# ENV hashes is also not always null terminated.
f24fdb76 578#
284167a5
SM
579if (${^TAINT}) {
580 do_test('tainted value in %ENV',
581 $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
99331854
YST
582'SV = PVMG\\($ADDR\\) at $ADDR
583 REFCNT = 1
12033064 584 FLAGS = \\(GMG,SMG,RMG(?:,POK)?(?:,pIOK)?,pPOK\\)
99331854
YST
585 IV = 0
586 NV = 0
587 PV = $ADDR "0"\\\0
588 CUR = 1
589 LEN = \d+
590 MAGIC = $ADDR
591 MG_VIRTUAL = &PL_vtbl_envelem
592 MG_TYPE = PERL_MAGIC_envelem\\(e\\)
d25a523c 593(?: MG_FLAGS = 0x01
99331854 594 TAINTEDDIR
143a3e5e
CB
595)? MG_LEN = -?\d+
596 MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
5e836f43 597 SV = PV(?:IV)?\\($ADDR\\) at $ADDR
143a3e5e 598 REFCNT = \d+
11e2783c 599 FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
f0fabfd7 600(?: IV = 0
d9baf692 601)? PV = $ADDR "(?i:PATH)"(?:\\\0)?
143a3e5e
CB
602 CUR = \d+
603 LEN = \d+)
99331854
YST
604 MAGIC = $ADDR
605 MG_VIRTUAL = &PL_vtbl_taint
606 MG_TYPE = PERL_MAGIC_taint\\(t\\)');
284167a5 607}
99331854 608
06a5cade 609do_test('blessed reference',
6bf47b08 610 bless(\\undef, 'Foobar'),
4df7f6af 611'SV = $RV\\($ADDR\\) at $ADDR
6bf47b08
SR
612 REFCNT = 1
613 FLAGS = \\(ROK\\)
614 RV = $ADDR
615 SV = PVMG\\($ADDR\\) at $ADDR
616 REFCNT = 2
617 FLAGS = \\(OBJECT,ROK\\)
7957ad98
MB
618 IV = -?\d+
619 NV = $FLOAT
6bf47b08
SR
620 RV = $ADDR
621 SV = NULL\\(0x0\\) at $ADDR
622 REFCNT = \d+
623 FLAGS = \\(READONLY\\)
624 PV = $ADDR ""
625 CUR = 0
626 LEN = 0
627 STASH = $ADDR\s+"Foobar"');
b1886099 628
b1886099
NC
629sub const () {
630 "Perl rules";
631}
632
06a5cade 633do_test('constant subroutine',
b1886099 634 \&const,
4df7f6af 635'SV = $RV\\($ADDR\\) at $ADDR
b1886099
NC
636 REFCNT = 1
637 FLAGS = \\(ROK\\)
638 RV = $ADDR
639 SV = PVCV\\($ADDR\\) at $ADDR
640 REFCNT = (2)
bad4ae38
FC
641 FLAGS = \\(POK,pPOK,CONST,ISXSUB\\) # $] < 5.015
642 FLAGS = \\(POK,pPOK,CONST,DYNFILE,ISXSUB\\) # $] >= 5.015
1bcecb77
NC
643 IV = 0 # $] < 5.009
644 NV = 0 # $] < 5.009
b1886099
NC
645 PROTOTYPE = ""
646 COMP_STASH = 0x0
1bcecb77 647 ROOT = 0x0 # $] < 5.009
b1886099
NC
648 XSUB = $ADDR
649 XSUBANY = $ADDR \\(CONST SV\\)
650 SV = PV\\($ADDR\\) at $ADDR
651 REFCNT = 1
652 FLAGS = \\(.*POK,READONLY,pPOK\\)
653 PV = $ADDR "Perl rules"\\\0
654 CUR = 10
655 LEN = \\d+
656 GVGV::GV = $ADDR\\t"main" :: "const"
657 FILE = ".*\\b(?i:peek\\.t)"
000fd473
NC
658 DEPTH = 0(?:
659 MUTEXP = $ADDR
660 OWNER = $ADDR)?
1bcecb77 661 FLAGS = 0x200 # $] < 5.009
c2485e0c 662 FLAGS = 0xc00 # $] >= 5.009 && $] < 5.013
bad4ae38
FC
663 FLAGS = 0xc # $] >= 5.013 && $] < 5.015
664 FLAGS = 0x100c # $] >= 5.015
b1886099
NC
665 OUTSIDE_SEQ = 0
666 PADLIST = 0x0
667 OUTSIDE = 0x0 \\(null\\)');
2e94196c 668
06a5cade 669do_test('isUV should show on PVMG',
2e94196c
NC
670 do { my $v = $1; $v = ~0; $v },
671'SV = PVMG\\($ADDR\\) at $ADDR
672 REFCNT = 1
673 FLAGS = \\(IOK,pIOK,IsUV\\)
674 UV = \d+
675 NV = 0
676 PV = 0');
c0a413d1 677
06a5cade 678do_test('IO',
c0a413d1
NC
679 *STDOUT{IO},
680'SV = $RV\\($ADDR\\) at $ADDR
681 REFCNT = 1
682 FLAGS = \\(ROK\\)
683 RV = $ADDR
684 SV = PVIO\\($ADDR\\) at $ADDR
685 REFCNT = 3
686 FLAGS = \\(OBJECT\\)
3cf51070 687 IV = 0 # $] < 5.011
1bcecb77 688 NV = 0 # $] < 5.011
d963bf01 689 STASH = $ADDR\s+"IO::File"
c0a413d1
NC
690 IFP = $ADDR
691 OFP = $ADDR
692 DIRP = 0x0
693 LINES = 0
694 PAGE = 0
695 PAGE_LEN = 60
696 LINES_LEFT = 0
697 TOP_GV = 0x0
698 FMT_GV = 0x0
699 BOTTOM_GV = 0x0
1bcecb77 700 SUBPROCESS = 0 # $] < 5.009
c0a413d1 701 TYPE = \'>\'
50a9fad1 702 FLAGS = 0x4');
bfe27a58 703
06a5cade 704do_test('FORMAT',
bfe27a58
NC
705 *PIE{FORMAT},
706'SV = $RV\\($ADDR\\) at $ADDR
707 REFCNT = 1
708 FLAGS = \\(ROK\\)
709 RV = $ADDR
710 SV = PVFM\\($ADDR\\) at $ADDR
711 REFCNT = 2
bad4ae38
FC
712 FLAGS = \\(\\) # $] < 5.015 || !thr
713 FLAGS = \\(DYNFILE\\) # $] >= 5.015 && thr
30ec677d 714 IV = 0 # $] < 5.009
bfe27a58 715 NV = 0 # $] < 5.009
251a4af1
DM
716(?: PV = 0
717)? COMP_STASH = 0x0
bfe27a58
NC
718 START = $ADDR ===> \\d+
719 ROOT = $ADDR
720 XSUB = 0x0 # $] < 5.009
721 XSUBANY = 0 # $] < 5.009
722 GVGV::GV = $ADDR\\t"main" :: "PIE"
bad4ae38 723 FILE = ".*\\b(?i:peek\\.t)"(?:
d3810ef8 724 DEPTH = 0)?(?:
c12100a4 725 MUTEXP = $ADDR
bad4ae38
FC
726 OWNER = $ADDR)?
727 FLAGS = 0x0 # $] < 5.015 || !thr
728 FLAGS = 0x1000 # $] >= 5.015 && thr
bfe27a58 729 OUTSIDE_SEQ = \\d+
d3810ef8 730 LINES = 0 # $] < 5.017_003
bfe27a58
NC
731 PADLIST = $ADDR
732 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
733 OUTSIDE = $ADDR \\(MAIN\\)');
d7d51f4b 734
b7b1e41b 735do_test('blessing to a class with embedded NUL characters',
d7d51f4b
YO
736 (bless {}, "\0::foo::\n::baz::\t::\0"),
737'SV = $RV\\($ADDR\\) at $ADDR
738 REFCNT = 1
739 FLAGS = \\(ROK\\)
740 RV = $ADDR
741 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 742 REFCNT = [12]
d7d51f4b
YO
743 FLAGS = \\(OBJECT,SHAREKEYS\\)
744 IV = 0 # $] < 5.009
745 NV = 0 # $] < 5.009
746 STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0"
747 ARRAY = $ADDR
748 KEYS = 0
749 FILL = 0
e1a7ec8d 750 MAX = 7', '',
f3ce8053
FC
751 $] > 5.009
752 ? $] >= 5.015
753 ? 0
754 : 'The hash iterator used in dump.c sets the OOK flag'
d7d51f4b
YO
755 : "Something causes the HV's array to become allocated");
756
bed53064
NC
757do_test('ENAME on a stash',
758 \%RWOM::,
759'SV = $RV\\($ADDR\\) at $ADDR
760 REFCNT = 1
761 FLAGS = \\(ROK\\)
762 RV = $ADDR
763 SV = PVHV\\($ADDR\\) at $ADDR
764 REFCNT = 2
765 FLAGS = \\(OOK,SHAREKEYS\\)
766 IV = 1 # $] < 5.009
767 NV = $FLOAT # $] < 5.009
768 ARRAY = $ADDR
769 KEYS = 0
9faf471a 770 FILL = 0 \(cached = 0\)
bed53064
NC
771 MAX = 7
772 RITER = -1
773 EITER = 0x0
e1a7ec8d 774 RAND = $ADDR
bed53064
NC
775 NAME = "RWOM"
776 ENAME = "RWOM" # $] > 5.012
777');
778
779*KLANK:: = \%RWOM::;
780
781do_test('ENAMEs on a stash',
782 \%RWOM::,
783'SV = $RV\\($ADDR\\) at $ADDR
784 REFCNT = 1
785 FLAGS = \\(ROK\\)
786 RV = $ADDR
787 SV = PVHV\\($ADDR\\) at $ADDR
788 REFCNT = 3
789 FLAGS = \\(OOK,SHAREKEYS\\)
790 IV = 1 # $] < 5.009
791 NV = $FLOAT # $] < 5.009
792 ARRAY = $ADDR
793 KEYS = 0
9faf471a 794 FILL = 0 \(cached = 0\)
bed53064
NC
795 MAX = 7
796 RITER = -1
797 EITER = 0x0
e1a7ec8d 798 RAND = $ADDR
bed53064
NC
799 NAME = "RWOM"
800 NAMECOUNT = 2 # $] > 5.012
801 ENAME = "RWOM", "KLANK" # $] > 5.012
802');
803
804undef %RWOM::;
805
806do_test('ENAMEs on a stash with no NAME',
807 \%RWOM::,
808'SV = $RV\\($ADDR\\) at $ADDR
809 REFCNT = 1
810 FLAGS = \\(ROK\\)
811 RV = $ADDR
812 SV = PVHV\\($ADDR\\) at $ADDR
813 REFCNT = 3
6acb8aa1
FC
814 FLAGS = \\(OOK,SHAREKEYS\\) # $] < 5.017
815 FLAGS = \\(OOK,OVERLOAD,SHAREKEYS\\) # $] >=5.017
bed53064
NC
816 IV = 1 # $] < 5.009
817 NV = $FLOAT # $] < 5.009
818 ARRAY = $ADDR
819 KEYS = 0
9faf471a 820 FILL = 0 \(cached = 0\)
bed53064
NC
821 MAX = 7
822 RITER = -1
823 EITER = 0x0
e1a7ec8d 824 RAND = $ADDR
bed53064
NC
825 NAMECOUNT = -3 # $] > 5.012
826 ENAME = "RWOM", "KLANK" # $] > 5.012
827');
828
9faf471a
NC
829my %small = ("Perl", "Rules", "Beer", "Foamy");
830my $b = %small;
831do_test('small hash',
832 \%small,
833'SV = $RV\\($ADDR\\) at $ADDR
834 REFCNT = 1
835 FLAGS = \\(ROK\\)
836 RV = $ADDR
837 SV = PVHV\\($ADDR\\) at $ADDR
838 REFCNT = 2
839 FLAGS = \\(PADMY,SHAREKEYS\\)
840 IV = 1 # $] < 5.009
841 NV = $FLOAT # $] < 5.009
842 ARRAY = $ADDR \\(0:[67],.*\\)
843 hash quality = [0-9.]+%
844 KEYS = 2
845 FILL = [12]
846 MAX = 7
847(?: Elt "(?:Perl|Beer)" HASH = $ADDR
848 SV = PV\\($ADDR\\) at $ADDR
849 REFCNT = 1
850 FLAGS = \\(POK,pPOK\\)
851 PV = $ADDR "(?:Rules|Foamy)"\\\0
852 CUR = \d+
853 LEN = \d+
854){2}');
855
856$b = keys %small;
857
858do_test('small hash after keys',
859 \%small,
860'SV = $RV\\($ADDR\\) at $ADDR
861 REFCNT = 1
862 FLAGS = \\(ROK\\)
863 RV = $ADDR
864 SV = PVHV\\($ADDR\\) at $ADDR
865 REFCNT = 2
866 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
867 IV = 1 # $] < 5.009
868 NV = $FLOAT # $] < 5.009
869 ARRAY = $ADDR \\(0:[67],.*\\)
870 hash quality = [0-9.]+%
871 KEYS = 2
872 FILL = [12] \\(cached = 0\\)
873 MAX = 7
874 RITER = -1
875 EITER = 0x0
876 RAND = $ADDR
877(?: Elt "(?:Perl|Beer)" HASH = $ADDR
878 SV = PV\\($ADDR\\) at $ADDR
879 REFCNT = 1
880 FLAGS = \\(POK,pPOK\\)
881 PV = $ADDR "(?:Rules|Foamy)"\\\0
882 CUR = \d+
883 LEN = \d+
884){2}');
885
886$b = %small;
887
888do_test('small hash after keys and scalar',
889 \%small,
890'SV = $RV\\($ADDR\\) at $ADDR
891 REFCNT = 1
892 FLAGS = \\(ROK\\)
893 RV = $ADDR
894 SV = PVHV\\($ADDR\\) at $ADDR
895 REFCNT = 2
896 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
897 IV = 1 # $] < 5.009
898 NV = $FLOAT # $] < 5.009
899 ARRAY = $ADDR \\(0:[67],.*\\)
900 hash quality = [0-9.]+%
901 KEYS = 2
902 FILL = ([12]) \\(cached = \1\\)
903 MAX = 7
904 RITER = -1
905 EITER = 0x0
906 RAND = $ADDR
907(?: Elt "(?:Perl|Beer)" HASH = $ADDR
908 SV = PV\\($ADDR\\) at $ADDR
909 REFCNT = 1
910 FLAGS = \\(POK,pPOK\\)
911 PV = $ADDR "(?:Rules|Foamy)"\\\0
912 CUR = \d+
913 LEN = \d+
914){2}');
915
916# This should immediately start with the FILL cached correctly.
917my %large = (0..1999);
918$b = %large;
919do_test('large hash',
920 \%large,
921'SV = $RV\\($ADDR\\) at $ADDR
922 REFCNT = 1
923 FLAGS = \\(ROK\\)
924 RV = $ADDR
925 SV = PVHV\\($ADDR\\) at $ADDR
926 REFCNT = 2
927 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
928 IV = 1 # $] < 5.009
929 NV = $FLOAT # $] < 5.009
930 ARRAY = $ADDR \\(0:\d+,.*\\)
931 hash quality = \d+\\.\d+%
932 KEYS = 1000
933 FILL = (\d+) \\(cached = \1\\)
934 MAX = 1023
935 RITER = -1
936 EITER = 0x0
937 RAND = $ADDR
938 Elt .*
939');
940
4ab5bd5f
FC
941SKIP: {
942 skip "Not built with usemymalloc", 1
943 unless $Config{usemymalloc} eq 'y';
944 my $x = __PACKAGE__;
945 ok eval { fill_mstats($x); 1 }, 'fill_mstats on COW scalar'
946 or diag $@;
947}
948
bc9a5256
NC
949# This is more a test of fbm_compile/pp_study (non) interaction than dumping
950# prowess, but short of duplicating all the gubbins of this file, I can't see
951# a way to make a better place for it:
952
ccbcbb3d
NC
953use constant {
954 perl => 'rules',
955 beer => 'foamy',
956};
0a0c4b76
NC
957
958unless ($Config{useithreads}) {
959 # These end up as copies in pads under ithreads, which rather defeats the
960 # the point of what we're trying to test here.
961
962 do_test('regular string constant', perl,
963'SV = PV\\($ADDR\\) at $ADDR
bc9a5256 964 REFCNT = 5
0a0c4b76
NC
965 FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
966 PV = $ADDR "rules"\\\0
967 CUR = 5
968 LEN = \d+
969');
970
971 eval 'index "", perl';
972
973 # FIXME - really this shouldn't say EVALED. It's a false posistive on
974 # 0x40000000 being used for several things, not a flag for "I'm in a string
975 # eval"
976
977 do_test('string constant now an FBM', perl,
c13a5c80 978'SV = PVMG\\($ADDR\\) at $ADDR
bc9a5256
NC
979 REFCNT = 5
980 FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
981 PV = $ADDR "rules"\\\0
982 CUR = 5
983 LEN = \d+
984 MAGIC = $ADDR
b76b0bf9 985 MG_VIRTUAL = &PL_vtbl_regexp
bc9a5256 986 MG_TYPE = PERL_MAGIC_bm\\(B\\)
2bda37ba
NC
987 MG_LEN = 256
988 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
989 RARE = \d+ # $] < 5.019002
990 PREVIOUS = 1 # $] < 5.019002
bc9a5256
NC
991 USEFUL = 100
992');
993
994 is(study perl, '', "Not allowed to study an FBM");
995
996 do_test('string constant still an FBM', perl,
c13a5c80 997'SV = PVMG\\($ADDR\\) at $ADDR
bc9a5256 998 REFCNT = 5
0a0c4b76
NC
999 FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
1000 PV = $ADDR "rules"\\\0
1001 CUR = 5
1002 LEN = \d+
1003 MAGIC = $ADDR
b76b0bf9 1004 MG_VIRTUAL = &PL_vtbl_regexp
0a0c4b76 1005 MG_TYPE = PERL_MAGIC_bm\\(B\\)
2bda37ba
NC
1006 MG_LEN = 256
1007 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
1008 RARE = \d+ # $] < 5.019002
1009 PREVIOUS = 1 # $] < 5.019002
0a0c4b76
NC
1010 USEFUL = 100
1011');
ccbcbb3d
NC
1012
1013 do_test('regular string constant', beer,
1014'SV = PV\\($ADDR\\) at $ADDR
4185c919 1015 REFCNT = 6
ccbcbb3d
NC
1016 FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
1017 PV = $ADDR "foamy"\\\0
1018 CUR = 5
1019 LEN = \d+
1020');
1021
a58a85fa
AMS
1022 is(study beer, 1, "Our studies were successful");
1023
1024 do_test('string constant quite unaffected', beer, 'SV = PV\\($ADDR\\) at $ADDR
1025 REFCNT = 6
1026 FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
1027 PV = $ADDR "foamy"\\\0
1028 CUR = 5
1029 LEN = \d+
1030');
1031
4185c919 1032 my $want = 'SV = PVMG\\($ADDR\\) at $ADDR
4265b45d 1033 REFCNT = 6
a58a85fa 1034 FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
4265b45d
NC
1035 PV = $ADDR "foamy"\\\0
1036 CUR = 5
1037 LEN = \d+
1038 MAGIC = $ADDR
0177730e 1039 MG_VIRTUAL = &PL_vtbl_regexp
a58a85fa
AMS
1040 MG_TYPE = PERL_MAGIC_bm\\(B\\)
1041 MG_LEN = 256
1042 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
1043 RARE = \d+ # $] < 5.019002
1044 PREVIOUS = \d+ # $] < 5.019002
a58a85fa 1045 USEFUL = 100
4185c919
NC
1046';
1047
4265b45d
NC
1048 is (eval 'index "not too foamy", beer', 8, 'correct index');
1049
a58a85fa 1050 do_test('string constant now FBMed', beer, $want);
4185c919
NC
1051
1052 my $pie = 'good';
1053
1054 is(study $pie, 1, "Our studies were successful");
1055
a58a85fa 1056 do_test('string constant still FBMed', beer, $want);
4185c919 1057
a58a85fa 1058 do_test('second string also unaffected', $pie, 'SV = PV\\($ADDR\\) at $ADDR
4185c919 1059 REFCNT = 1
a58a85fa 1060 FLAGS = \\(PADMY,POK,pPOK\\)
4185c919
NC
1061 PV = $ADDR "good"\\\0
1062 CUR = 4
ccbcbb3d 1063 LEN = \d+
ccbcbb3d 1064');
0a0c4b76
NC
1065}
1066
a58a85fa 1067# (One block of study tests removed when study was made a no-op.)
72de20cd 1068
486ffce2
FC
1069{
1070 open(OUT,">peek$$") or die "Failed to open peek $$: $!";
1071 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
1072 DeadCode();
1073 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
1074 pass "no crash with DeadCode";
7bf23f34 1075 close OUT;
486ffce2
FC
1076}
1077
8cdde9f8
NC
1078do_test('UTF-8 in a regular expression',
1079 qr/\x{100}/,
1080'SV = IV\($ADDR\) at $ADDR
1081 REFCNT = 1
1082 FLAGS = \(ROK\)
1083 RV = $ADDR
1084 SV = REGEXP\($ADDR\) at $ADDR
1085 REFCNT = 1
1086 FLAGS = \(OBJECT,FAKE,UTF8\)
1087 PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
1088 CUR = 13
1089 STASH = $ADDR "Regexp"
dbc200c5 1090 COMPFLAGS = 0x0 \(\)
8cdde9f8
NC
1091 EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
1092 INTFLAGS = 0x0
1093 NPARENS = 0
1094 LASTPAREN = 0
1095 LASTCLOSEPAREN = 0
1096 MINLEN = 1
1097 MINLENRET = 1
1098 GOFS = 0
1099 PRE_PREFIX = 5
1100 SUBLEN = 0
1101 SUBOFFSET = 0
1102 SUBCOFFSET = 0
1103 SUBBEG = 0x0
1104 ENGINE = $ADDR
01ffd0f1
FC
1105 MOTHER_RE = $ADDR'
1106. ($] < 5.019003 ? '' : '
1107 SV = REGEXP\($ADDR\) at $ADDR
1108 REFCNT = 2
1109 FLAGS = \(UTF8\)
1110 PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
1111 CUR = 13
1112 COMPFLAGS = 0x0 \(\)
1113 EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
1114 INTFLAGS = 0x0
1115 NPARENS = 0
1116 LASTPAREN = 0
1117 LASTCLOSEPAREN = 0
1118 MINLEN = 1
1119 MINLENRET = 1
1120 GOFS = 0
1121 PRE_PREFIX = 5
1122 SUBLEN = 0
1123 SUBOFFSET = 0
1124 SUBCOFFSET = 0
1125 SUBBEG = 0x0
1126 ENGINE = $ADDR
1127 MOTHER_RE = 0x0
1128 PAREN_NAMES = 0x0
1129 SUBSTRS = $ADDR
1130 PPRIVATE = $ADDR
1131 OFFS = $ADDR
1132 QR_ANONCV = 0x0(?:
1133 SAVED_COPY = 0x0)?') . '
8cdde9f8
NC
1134 PAREN_NAMES = 0x0
1135 SUBSTRS = $ADDR
1136 PPRIVATE = $ADDR
1137 OFFS = $ADDR
09af2132
DM
1138 QR_ANONCV = 0x0(?:
1139 SAVED_COPY = 0x0)?
8cdde9f8
NC
1140');
1141
da1929e7
TC
1142{ # perl #117793: Extend SvREFCNT* to work on any perl variable type
1143 my %hash;
1144 my $base_count = Devel::Peek::SvREFCNT(%hash);
1145 my $ref = \%hash;
1146 is(Devel::Peek::SvREFCNT(%hash), $base_count + 1, "SvREFCNT on non-scalar");
1147}
1148
06a5cade 1149done_testing();