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