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