This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow PADTMPs’ strings to be swiped
[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 90 if $Config{ccflags} =~
32ce4ca8
NC
91 /-DPERL_(?:OLD_COPY_ON_WRITE|NO_COW)/
92 || $] < 5.019003;
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 130 LEN = \\d+
32ce4ca8 131 COW_REFCNT = 1
7fa949d0 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 141 LEN = \\d+
32ce4ca8 142 COW_REFCNT = 0
7fa949d0 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 226 LEN = \\d+
32ce4ca8 227 COW_REFCNT = 1
7fa949d0 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 511 LEN = \\d+
9ffd39ab 512 COW_REFCNT = 1 # $] < 5.019006
7fa949d0 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 523 LEN = \\d+
9ffd39ab 524 COW_REFCNT = 1 # $] < 5.019006
7fa949d0 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 551 LEN = \\d+
9ffd39ab 552 COW_REFCNT = 1 # $] < 5.019006
7fa949d0 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 582 LEN = \\d+
9ffd39ab 583 COW_REFCNT = 1 # $] < 5.019006
7fa949d0 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\\)
25fdce4a
FC
608 MG_FLAGS = 0x01 # $] < 5.019003
609 MG_FLAGS = 0x41 # $] >=5.019003
610 MINMATCH
611 BYTES # $] >=5.019003
612');
99331854 613
f24fdb76
HS
614#
615# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
616# environment variables may be invisibly case-forced, hence the (?i:PATH)
5e836f43 617# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
12033064
CS
618# Perl 5.18 ensures all env vars end up as strings only, hence the (?:,pIOK)?
619# Perl 5.18 ensures even magic vars have public OK, hence the (?:,POK)?
d9baf692
JM
620# VMS is setting FAKE and READONLY flags. What VMS uses for storing
621# ENV hashes is also not always null terminated.
f24fdb76 622#
284167a5
SM
623if (${^TAINT}) {
624 do_test('tainted value in %ENV',
625 $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
99331854
YST
626'SV = PVMG\\($ADDR\\) at $ADDR
627 REFCNT = 1
12033064 628 FLAGS = \\(GMG,SMG,RMG(?:,POK)?(?:,pIOK)?,pPOK\\)
99331854
YST
629 IV = 0
630 NV = 0
631 PV = $ADDR "0"\\\0
632 CUR = 1
633 LEN = \d+
634 MAGIC = $ADDR
635 MG_VIRTUAL = &PL_vtbl_envelem
636 MG_TYPE = PERL_MAGIC_envelem\\(e\\)
d25a523c 637(?: MG_FLAGS = 0x01
99331854 638 TAINTEDDIR
143a3e5e
CB
639)? MG_LEN = -?\d+
640 MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
5e836f43 641 SV = PV(?:IV)?\\($ADDR\\) at $ADDR
143a3e5e 642 REFCNT = \d+
11e2783c 643 FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
f0fabfd7 644(?: IV = 0
d9baf692 645)? PV = $ADDR "(?i:PATH)"(?:\\\0)?
143a3e5e
CB
646 CUR = \d+
647 LEN = \d+)
99331854
YST
648 MAGIC = $ADDR
649 MG_VIRTUAL = &PL_vtbl_taint
650 MG_TYPE = PERL_MAGIC_taint\\(t\\)');
284167a5 651}
99331854 652
06a5cade 653do_test('blessed reference',
6bf47b08 654 bless(\\undef, 'Foobar'),
4df7f6af 655'SV = $RV\\($ADDR\\) at $ADDR
6bf47b08
SR
656 REFCNT = 1
657 FLAGS = \\(ROK\\)
658 RV = $ADDR
659 SV = PVMG\\($ADDR\\) at $ADDR
660 REFCNT = 2
661 FLAGS = \\(OBJECT,ROK\\)
7957ad98
MB
662 IV = -?\d+
663 NV = $FLOAT
6bf47b08
SR
664 RV = $ADDR
665 SV = NULL\\(0x0\\) at $ADDR
666 REFCNT = \d+
667 FLAGS = \\(READONLY\\)
668 PV = $ADDR ""
669 CUR = 0
670 LEN = 0
671 STASH = $ADDR\s+"Foobar"');
b1886099 672
b1886099
NC
673sub const () {
674 "Perl rules";
675}
676
06a5cade 677do_test('constant subroutine',
b1886099 678 \&const,
4df7f6af 679'SV = $RV\\($ADDR\\) at $ADDR
b1886099
NC
680 REFCNT = 1
681 FLAGS = \\(ROK\\)
682 RV = $ADDR
683 SV = PVCV\\($ADDR\\) at $ADDR
684 REFCNT = (2)
bad4ae38
FC
685 FLAGS = \\(POK,pPOK,CONST,ISXSUB\\) # $] < 5.015
686 FLAGS = \\(POK,pPOK,CONST,DYNFILE,ISXSUB\\) # $] >= 5.015
1bcecb77
NC
687 IV = 0 # $] < 5.009
688 NV = 0 # $] < 5.009
b1886099
NC
689 PROTOTYPE = ""
690 COMP_STASH = 0x0
1bcecb77 691 ROOT = 0x0 # $] < 5.009
b1886099
NC
692 XSUB = $ADDR
693 XSUBANY = $ADDR \\(CONST SV\\)
694 SV = PV\\($ADDR\\) at $ADDR
695 REFCNT = 1
7fa949d0 696 FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
b1886099
NC
697 PV = $ADDR "Perl rules"\\\0
698 CUR = 10
699 LEN = \\d+
32ce4ca8 700 COW_REFCNT = 0
b1886099
NC
701 GVGV::GV = $ADDR\\t"main" :: "const"
702 FILE = ".*\\b(?i:peek\\.t)"
000fd473
NC
703 DEPTH = 0(?:
704 MUTEXP = $ADDR
705 OWNER = $ADDR)?
1bcecb77 706 FLAGS = 0x200 # $] < 5.009
c2485e0c 707 FLAGS = 0xc00 # $] >= 5.009 && $] < 5.013
bad4ae38
FC
708 FLAGS = 0xc # $] >= 5.013 && $] < 5.015
709 FLAGS = 0x100c # $] >= 5.015
b1886099
NC
710 OUTSIDE_SEQ = 0
711 PADLIST = 0x0
712 OUTSIDE = 0x0 \\(null\\)');
2e94196c 713
06a5cade 714do_test('isUV should show on PVMG',
2e94196c
NC
715 do { my $v = $1; $v = ~0; $v },
716'SV = PVMG\\($ADDR\\) at $ADDR
717 REFCNT = 1
718 FLAGS = \\(IOK,pIOK,IsUV\\)
719 UV = \d+
720 NV = 0
721 PV = 0');
c0a413d1 722
06a5cade 723do_test('IO',
c0a413d1
NC
724 *STDOUT{IO},
725'SV = $RV\\($ADDR\\) at $ADDR
726 REFCNT = 1
727 FLAGS = \\(ROK\\)
728 RV = $ADDR
729 SV = PVIO\\($ADDR\\) at $ADDR
730 REFCNT = 3
731 FLAGS = \\(OBJECT\\)
3cf51070 732 IV = 0 # $] < 5.011
1bcecb77 733 NV = 0 # $] < 5.011
d963bf01 734 STASH = $ADDR\s+"IO::File"
c0a413d1
NC
735 IFP = $ADDR
736 OFP = $ADDR
737 DIRP = 0x0
738 LINES = 0
739 PAGE = 0
740 PAGE_LEN = 60
741 LINES_LEFT = 0
742 TOP_GV = 0x0
743 FMT_GV = 0x0
744 BOTTOM_GV = 0x0
1bcecb77 745 SUBPROCESS = 0 # $] < 5.009
c0a413d1 746 TYPE = \'>\'
50a9fad1 747 FLAGS = 0x4');
bfe27a58 748
06a5cade 749do_test('FORMAT',
bfe27a58
NC
750 *PIE{FORMAT},
751'SV = $RV\\($ADDR\\) at $ADDR
752 REFCNT = 1
753 FLAGS = \\(ROK\\)
754 RV = $ADDR
755 SV = PVFM\\($ADDR\\) at $ADDR
756 REFCNT = 2
bad4ae38
FC
757 FLAGS = \\(\\) # $] < 5.015 || !thr
758 FLAGS = \\(DYNFILE\\) # $] >= 5.015 && thr
30ec677d 759 IV = 0 # $] < 5.009
bfe27a58 760 NV = 0 # $] < 5.009
251a4af1
DM
761(?: PV = 0
762)? COMP_STASH = 0x0
bfe27a58
NC
763 START = $ADDR ===> \\d+
764 ROOT = $ADDR
765 XSUB = 0x0 # $] < 5.009
766 XSUBANY = 0 # $] < 5.009
767 GVGV::GV = $ADDR\\t"main" :: "PIE"
bad4ae38 768 FILE = ".*\\b(?i:peek\\.t)"(?:
d3810ef8 769 DEPTH = 0)?(?:
c12100a4 770 MUTEXP = $ADDR
bad4ae38
FC
771 OWNER = $ADDR)?
772 FLAGS = 0x0 # $] < 5.015 || !thr
773 FLAGS = 0x1000 # $] >= 5.015 && thr
bfe27a58 774 OUTSIDE_SEQ = \\d+
d3810ef8 775 LINES = 0 # $] < 5.017_003
bfe27a58
NC
776 PADLIST = $ADDR
777 PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
778 OUTSIDE = $ADDR \\(MAIN\\)');
d7d51f4b 779
b7b1e41b 780do_test('blessing to a class with embedded NUL characters',
d7d51f4b
YO
781 (bless {}, "\0::foo::\n::baz::\t::\0"),
782'SV = $RV\\($ADDR\\) at $ADDR
783 REFCNT = 1
784 FLAGS = \\(ROK\\)
785 RV = $ADDR
786 SV = PVHV\\($ADDR\\) at $ADDR
3ed356df 787 REFCNT = [12]
d7d51f4b
YO
788 FLAGS = \\(OBJECT,SHAREKEYS\\)
789 IV = 0 # $] < 5.009
790 NV = 0 # $] < 5.009
791 STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0"
792 ARRAY = $ADDR
793 KEYS = 0
794 FILL = 0
e1a7ec8d 795 MAX = 7', '',
f3ce8053
FC
796 $] > 5.009
797 ? $] >= 5.015
798 ? 0
799 : 'The hash iterator used in dump.c sets the OOK flag'
d7d51f4b
YO
800 : "Something causes the HV's array to become allocated");
801
bed53064
NC
802do_test('ENAME on a stash',
803 \%RWOM::,
804'SV = $RV\\($ADDR\\) at $ADDR
805 REFCNT = 1
806 FLAGS = \\(ROK\\)
807 RV = $ADDR
808 SV = PVHV\\($ADDR\\) at $ADDR
809 REFCNT = 2
810 FLAGS = \\(OOK,SHAREKEYS\\)
811 IV = 1 # $] < 5.009
812 NV = $FLOAT # $] < 5.009
813 ARRAY = $ADDR
814 KEYS = 0
9faf471a 815 FILL = 0 \(cached = 0\)
bed53064
NC
816 MAX = 7
817 RITER = -1
818 EITER = 0x0
e1a7ec8d 819 RAND = $ADDR
bed53064
NC
820 NAME = "RWOM"
821 ENAME = "RWOM" # $] > 5.012
822');
823
824*KLANK:: = \%RWOM::;
825
826do_test('ENAMEs on a stash',
827 \%RWOM::,
828'SV = $RV\\($ADDR\\) at $ADDR
829 REFCNT = 1
830 FLAGS = \\(ROK\\)
831 RV = $ADDR
832 SV = PVHV\\($ADDR\\) at $ADDR
833 REFCNT = 3
834 FLAGS = \\(OOK,SHAREKEYS\\)
835 IV = 1 # $] < 5.009
836 NV = $FLOAT # $] < 5.009
837 ARRAY = $ADDR
838 KEYS = 0
9faf471a 839 FILL = 0 \(cached = 0\)
bed53064
NC
840 MAX = 7
841 RITER = -1
842 EITER = 0x0
e1a7ec8d 843 RAND = $ADDR
bed53064
NC
844 NAME = "RWOM"
845 NAMECOUNT = 2 # $] > 5.012
846 ENAME = "RWOM", "KLANK" # $] > 5.012
847');
848
849undef %RWOM::;
850
851do_test('ENAMEs on a stash with no NAME',
852 \%RWOM::,
853'SV = $RV\\($ADDR\\) at $ADDR
854 REFCNT = 1
855 FLAGS = \\(ROK\\)
856 RV = $ADDR
857 SV = PVHV\\($ADDR\\) at $ADDR
858 REFCNT = 3
6acb8aa1
FC
859 FLAGS = \\(OOK,SHAREKEYS\\) # $] < 5.017
860 FLAGS = \\(OOK,OVERLOAD,SHAREKEYS\\) # $] >=5.017
bed53064
NC
861 IV = 1 # $] < 5.009
862 NV = $FLOAT # $] < 5.009
863 ARRAY = $ADDR
864 KEYS = 0
9faf471a 865 FILL = 0 \(cached = 0\)
bed53064
NC
866 MAX = 7
867 RITER = -1
868 EITER = 0x0
e1a7ec8d 869 RAND = $ADDR
bed53064
NC
870 NAMECOUNT = -3 # $] > 5.012
871 ENAME = "RWOM", "KLANK" # $] > 5.012
872');
873
9faf471a
NC
874my %small = ("Perl", "Rules", "Beer", "Foamy");
875my $b = %small;
876do_test('small hash',
877 \%small,
878'SV = $RV\\($ADDR\\) at $ADDR
879 REFCNT = 1
880 FLAGS = \\(ROK\\)
881 RV = $ADDR
882 SV = PVHV\\($ADDR\\) at $ADDR
883 REFCNT = 2
884 FLAGS = \\(PADMY,SHAREKEYS\\)
885 IV = 1 # $] < 5.009
886 NV = $FLOAT # $] < 5.009
887 ARRAY = $ADDR \\(0:[67],.*\\)
888 hash quality = [0-9.]+%
889 KEYS = 2
890 FILL = [12]
891 MAX = 7
892(?: Elt "(?:Perl|Beer)" HASH = $ADDR
893 SV = PV\\($ADDR\\) at $ADDR
894 REFCNT = 1
7fa949d0 895 FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
9faf471a
NC
896 PV = $ADDR "(?:Rules|Foamy)"\\\0
897 CUR = \d+
898 LEN = \d+
32ce4ca8 899 COW_REFCNT = 1
9faf471a
NC
900){2}');
901
902$b = keys %small;
903
904do_test('small hash after keys',
905 \%small,
906'SV = $RV\\($ADDR\\) at $ADDR
907 REFCNT = 1
908 FLAGS = \\(ROK\\)
909 RV = $ADDR
910 SV = PVHV\\($ADDR\\) at $ADDR
911 REFCNT = 2
912 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
913 IV = 1 # $] < 5.009
914 NV = $FLOAT # $] < 5.009
915 ARRAY = $ADDR \\(0:[67],.*\\)
916 hash quality = [0-9.]+%
917 KEYS = 2
918 FILL = [12] \\(cached = 0\\)
919 MAX = 7
920 RITER = -1
921 EITER = 0x0
922 RAND = $ADDR
923(?: Elt "(?:Perl|Beer)" HASH = $ADDR
924 SV = PV\\($ADDR\\) at $ADDR
925 REFCNT = 1
7fa949d0 926 FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
9faf471a
NC
927 PV = $ADDR "(?:Rules|Foamy)"\\\0
928 CUR = \d+
929 LEN = \d+
32ce4ca8 930 COW_REFCNT = 1
9faf471a
NC
931){2}');
932
933$b = %small;
934
935do_test('small hash after keys and scalar',
936 \%small,
937'SV = $RV\\($ADDR\\) at $ADDR
938 REFCNT = 1
939 FLAGS = \\(ROK\\)
940 RV = $ADDR
941 SV = PVHV\\($ADDR\\) at $ADDR
942 REFCNT = 2
943 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
944 IV = 1 # $] < 5.009
945 NV = $FLOAT # $] < 5.009
946 ARRAY = $ADDR \\(0:[67],.*\\)
947 hash quality = [0-9.]+%
948 KEYS = 2
949 FILL = ([12]) \\(cached = \1\\)
950 MAX = 7
951 RITER = -1
952 EITER = 0x0
953 RAND = $ADDR
954(?: Elt "(?:Perl|Beer)" HASH = $ADDR
955 SV = PV\\($ADDR\\) at $ADDR
956 REFCNT = 1
7fa949d0 957 FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
9faf471a
NC
958 PV = $ADDR "(?:Rules|Foamy)"\\\0
959 CUR = \d+
960 LEN = \d+
32ce4ca8 961 COW_REFCNT = 1
9faf471a
NC
962){2}');
963
964# This should immediately start with the FILL cached correctly.
965my %large = (0..1999);
966$b = %large;
967do_test('large hash',
968 \%large,
969'SV = $RV\\($ADDR\\) at $ADDR
970 REFCNT = 1
971 FLAGS = \\(ROK\\)
972 RV = $ADDR
973 SV = PVHV\\($ADDR\\) at $ADDR
974 REFCNT = 2
975 FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
976 IV = 1 # $] < 5.009
977 NV = $FLOAT # $] < 5.009
978 ARRAY = $ADDR \\(0:\d+,.*\\)
979 hash quality = \d+\\.\d+%
980 KEYS = 1000
981 FILL = (\d+) \\(cached = \1\\)
982 MAX = 1023
983 RITER = -1
984 EITER = 0x0
985 RAND = $ADDR
986 Elt .*
987');
988
34b94bc4
FC
989# Dump with arrays, hashes, and operator return values
990@array = 1..3;
991do_test('Dump @array', '@array', <<'ARRAY', '', '', 1);
992SV = PVAV\($ADDR\) at $ADDR
993 REFCNT = 1
994 FLAGS = \(\)
995 ARRAY = $ADDR
996 FILL = 2
997 MAX = 3
998 ARYLEN = 0x0
999 FLAGS = \(REAL\)
1000 Elt No. 0
1001 SV = IV\($ADDR\) at $ADDR
1002 REFCNT = 1
1003 FLAGS = \(IOK,pIOK\)
1004 IV = 1
1005 Elt No. 1
1006 SV = IV\($ADDR\) at $ADDR
1007 REFCNT = 1
1008 FLAGS = \(IOK,pIOK\)
1009 IV = 2
1010 Elt No. 2
1011 SV = IV\($ADDR\) at $ADDR
1012 REFCNT = 1
1013 FLAGS = \(IOK,pIOK\)
1014 IV = 3
1015ARRAY
1016%hash = 1..2;
1017do_test('Dump %hash', '%hash', <<'HASH', '', '', 1);
1018SV = PVHV\($ADDR\) at $ADDR
1019 REFCNT = 1
1020 FLAGS = \(SHAREKEYS\)
1021 ARRAY = $ADDR \(0:7, 1:1\)
1022 hash quality = 100.0%
1023 KEYS = 1
1024 FILL = 1
1025 MAX = 7
1026 Elt "1" HASH = $ADDR
1027 SV = IV\($ADDR\) at $ADDR
1028 REFCNT = 1
1029 FLAGS = \(IOK,pIOK\)
1030 IV = 2
1031HASH
1032$_ = "hello";
1033do_test('rvalue substr', 'substr $_, 1, 2', <<'SUBSTR', '', '', 1);
1034SV = PV\($ADDR\) at $ADDR
1035 REFCNT = 1
1036 FLAGS = \(PADTMP,POK,pPOK\)
1037 PV = $ADDR "el"\\0
1038 CUR = 2
1039 LEN = \d+
1040SUBSTR
1041
313efa90
FC
1042# Dump with no arguments
1043eval 'Dump';
1044like $@, qr/^Not enough arguments for Devel::Peek::Dump/, 'Dump;';
1045eval 'Dump()';
1046like $@, qr/^Not enough arguments for Devel::Peek::Dump/, 'Dump()';
1047
4ab5bd5f 1048SKIP: {
b59747ac 1049 skip "Not built with usemymalloc", 2
4ab5bd5f
FC
1050 unless $Config{usemymalloc} eq 'y';
1051 my $x = __PACKAGE__;
1052 ok eval { fill_mstats($x); 1 }, 'fill_mstats on COW scalar'
1053 or diag $@;
b59747ac
FC
1054 my $y;
1055 ok eval { fill_mstats($y); 1 }, 'fill_mstats on undef scalar';
4ab5bd5f
FC
1056}
1057
bc9a5256
NC
1058# This is more a test of fbm_compile/pp_study (non) interaction than dumping
1059# prowess, but short of duplicating all the gubbins of this file, I can't see
1060# a way to make a better place for it:
1061
ccbcbb3d
NC
1062use constant {
1063 perl => 'rules',
1064 beer => 'foamy',
1065};
0a0c4b76
NC
1066
1067unless ($Config{useithreads}) {
1068 # These end up as copies in pads under ithreads, which rather defeats the
1069 # the point of what we're trying to test here.
1070
1071 do_test('regular string constant', perl,
1072'SV = PV\\($ADDR\\) at $ADDR
bc9a5256 1073 REFCNT = 5
e811af66 1074 FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
0a0c4b76
NC
1075 PV = $ADDR "rules"\\\0
1076 CUR = 5
1077 LEN = \d+
32ce4ca8 1078 COW_REFCNT = 0
0a0c4b76
NC
1079');
1080
1081 eval 'index "", perl';
1082
1083 # FIXME - really this shouldn't say EVALED. It's a false posistive on
1084 # 0x40000000 being used for several things, not a flag for "I'm in a string
1085 # eval"
1086
1087 do_test('string constant now an FBM', perl,
c13a5c80 1088'SV = PVMG\\($ADDR\\) at $ADDR
bc9a5256 1089 REFCNT = 5
e811af66 1090 FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
bc9a5256
NC
1091 PV = $ADDR "rules"\\\0
1092 CUR = 5
1093 LEN = \d+
32ce4ca8 1094 COW_REFCNT = 0
bc9a5256 1095 MAGIC = $ADDR
b76b0bf9 1096 MG_VIRTUAL = &PL_vtbl_regexp
bc9a5256 1097 MG_TYPE = PERL_MAGIC_bm\\(B\\)
2bda37ba
NC
1098 MG_LEN = 256
1099 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
1100 RARE = \d+ # $] < 5.019002
1101 PREVIOUS = 1 # $] < 5.019002
bc9a5256
NC
1102 USEFUL = 100
1103');
1104
1105 is(study perl, '', "Not allowed to study an FBM");
1106
1107 do_test('string constant still an FBM', perl,
c13a5c80 1108'SV = PVMG\\($ADDR\\) at $ADDR
bc9a5256 1109 REFCNT = 5
e811af66 1110 FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
0a0c4b76
NC
1111 PV = $ADDR "rules"\\\0
1112 CUR = 5
1113 LEN = \d+
32ce4ca8 1114 COW_REFCNT = 0
0a0c4b76 1115 MAGIC = $ADDR
b76b0bf9 1116 MG_VIRTUAL = &PL_vtbl_regexp
0a0c4b76 1117 MG_TYPE = PERL_MAGIC_bm\\(B\\)
2bda37ba
NC
1118 MG_LEN = 256
1119 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
1120 RARE = \d+ # $] < 5.019002
1121 PREVIOUS = 1 # $] < 5.019002
0a0c4b76
NC
1122 USEFUL = 100
1123');
ccbcbb3d
NC
1124
1125 do_test('regular string constant', beer,
1126'SV = PV\\($ADDR\\) at $ADDR
4185c919 1127 REFCNT = 6
e811af66 1128 FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
ccbcbb3d
NC
1129 PV = $ADDR "foamy"\\\0
1130 CUR = 5
1131 LEN = \d+
32ce4ca8 1132 COW_REFCNT = 0
ccbcbb3d
NC
1133');
1134
a58a85fa
AMS
1135 is(study beer, 1, "Our studies were successful");
1136
1137 do_test('string constant quite unaffected', beer, 'SV = PV\\($ADDR\\) at $ADDR
1138 REFCNT = 6
e811af66 1139 FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
a58a85fa
AMS
1140 PV = $ADDR "foamy"\\\0
1141 CUR = 5
1142 LEN = \d+
32ce4ca8 1143 COW_REFCNT = 0
a58a85fa
AMS
1144');
1145
4185c919 1146 my $want = 'SV = PVMG\\($ADDR\\) at $ADDR
4265b45d 1147 REFCNT = 6
e811af66 1148 FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
4265b45d
NC
1149 PV = $ADDR "foamy"\\\0
1150 CUR = 5
1151 LEN = \d+
32ce4ca8 1152 COW_REFCNT = 0
4265b45d 1153 MAGIC = $ADDR
0177730e 1154 MG_VIRTUAL = &PL_vtbl_regexp
a58a85fa
AMS
1155 MG_TYPE = PERL_MAGIC_bm\\(B\\)
1156 MG_LEN = 256
1157 MG_PTR = $ADDR "(?:\\\\\d){256}"
8922e438
FC
1158 RARE = \d+ # $] < 5.019002
1159 PREVIOUS = \d+ # $] < 5.019002
a58a85fa 1160 USEFUL = 100
4185c919
NC
1161';
1162
4265b45d
NC
1163 is (eval 'index "not too foamy", beer', 8, 'correct index');
1164
a58a85fa 1165 do_test('string constant now FBMed', beer, $want);
4185c919
NC
1166
1167 my $pie = 'good';
1168
1169 is(study $pie, 1, "Our studies were successful");
1170
a58a85fa 1171 do_test('string constant still FBMed', beer, $want);
4185c919 1172
a58a85fa 1173 do_test('second string also unaffected', $pie, 'SV = PV\\($ADDR\\) at $ADDR
4185c919 1174 REFCNT = 1
abbcae52 1175 FLAGS = \\(PADMY,POK,(?:IsCOW,)?pPOK\\)
4185c919
NC
1176 PV = $ADDR "good"\\\0
1177 CUR = 4
fb1c5e87
NC
1178 LEN = \d+
1179 COW_REFCNT = 1
ccbcbb3d 1180');
0a0c4b76
NC
1181}
1182
a58a85fa 1183# (One block of study tests removed when study was made a no-op.)
72de20cd 1184
486ffce2
FC
1185{
1186 open(OUT,">peek$$") or die "Failed to open peek $$: $!";
1187 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
1188 DeadCode();
1189 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
1190 pass "no crash with DeadCode";
7bf23f34 1191 close OUT;
486ffce2
FC
1192}
1193
8cdde9f8
NC
1194do_test('UTF-8 in a regular expression',
1195 qr/\x{100}/,
1196'SV = IV\($ADDR\) at $ADDR
1197 REFCNT = 1
1198 FLAGS = \(ROK\)
1199 RV = $ADDR
1200 SV = REGEXP\($ADDR\) at $ADDR
1201 REFCNT = 1
1202 FLAGS = \(OBJECT,FAKE,UTF8\)
1203 PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
1204 CUR = 13
1205 STASH = $ADDR "Regexp"
dbc200c5 1206 COMPFLAGS = 0x0 \(\)
8cdde9f8
NC
1207 EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
1208 INTFLAGS = 0x0
1209 NPARENS = 0
1210 LASTPAREN = 0
1211 LASTCLOSEPAREN = 0
1212 MINLEN = 1
1213 MINLENRET = 1
1214 GOFS = 0
1215 PRE_PREFIX = 5
1216 SUBLEN = 0
1217 SUBOFFSET = 0
1218 SUBCOFFSET = 0
1219 SUBBEG = 0x0
1220 ENGINE = $ADDR
01ffd0f1
FC
1221 MOTHER_RE = $ADDR'
1222. ($] < 5.019003 ? '' : '
1223 SV = REGEXP\($ADDR\) at $ADDR
1224 REFCNT = 2
1225 FLAGS = \(UTF8\)
1226 PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
1227 CUR = 13
1228 COMPFLAGS = 0x0 \(\)
1229 EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
1230 INTFLAGS = 0x0
1231 NPARENS = 0
1232 LASTPAREN = 0
1233 LASTCLOSEPAREN = 0
1234 MINLEN = 1
1235 MINLENRET = 1
1236 GOFS = 0
1237 PRE_PREFIX = 5
1238 SUBLEN = 0
1239 SUBOFFSET = 0
1240 SUBCOFFSET = 0
1241 SUBBEG = 0x0
1242 ENGINE = $ADDR
1243 MOTHER_RE = 0x0
1244 PAREN_NAMES = 0x0
1245 SUBSTRS = $ADDR
1246 PPRIVATE = $ADDR
1247 OFFS = $ADDR
1248 QR_ANONCV = 0x0(?:
1249 SAVED_COPY = 0x0)?') . '
8cdde9f8
NC
1250 PAREN_NAMES = 0x0
1251 SUBSTRS = $ADDR
1252 PPRIVATE = $ADDR
1253 OFFS = $ADDR
09af2132
DM
1254 QR_ANONCV = 0x0(?:
1255 SAVED_COPY = 0x0)?
8cdde9f8
NC
1256');
1257
da1929e7
TC
1258{ # perl #117793: Extend SvREFCNT* to work on any perl variable type
1259 my %hash;
1260 my $base_count = Devel::Peek::SvREFCNT(%hash);
1261 my $ref = \%hash;
1262 is(Devel::Peek::SvREFCNT(%hash), $base_count + 1, "SvREFCNT on non-scalar");
1263}
1264
06a5cade 1265done_testing();