This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #92260] Devel::Peek::fill_mstats and non-PVs
[perl5.git] / ext / Devel-Peek / t / Peek.t
1 #!./perl -T
2
3 BEGIN {
4     require Config; import Config;
5     if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) {
6         print "1..0 # Skip: Devel::Peek was not built\n";
7         exit 0;
8     }
9 }
10
11 use Test::More;
12
13 use Devel::Peek;
14
15 our $DEBUG = 0;
16 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
17
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.
21 format PIE =
22 Pie     @<<<<<
23 $::type
24 Good    @>>>>>
25 $::mmmm
26 .
27
28 use constant thr => $Config{useithreads};
29
30 sub do_test {
31     my $todo = $_[3];
32     my $repeat_todo = $_[4];
33     my $pattern = $_[2];
34     if (open(OUT,">peek$$")) {
35         open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
36         Dump($_[1]);
37         print STDERR "*****\n";
38         Dump($_[1]); # second dump to compare with the first to make sure nothing changed.
39         open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
40         close(OUT);
41         if (open(IN, "peek$$")) {
42             local $/;
43             $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
44             $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
45             # handle DEBUG_LEAKING_SCALARS prefix
46             $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
47
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
53             # whitespace on the line. So it seems better to mark lines that
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
62                 s/\s*# (\$].*)$//
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;
73             $pattern =~ s/\$RV/
74                 ($] < 5.011) ? 'RV' : 'IV';
75             /mge;
76             $pattern =~ s/^\h+COW_REFCNT = \d+\h*\n//mg
77                 if $Config{ccflags} =~
78                         /-DPERL_(?:OLD_COPY_ON_WRITE|NO_COW)/;
79
80             print $pattern, "\n" if $DEBUG;
81             my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
82             print $dump, "\n"    if $DEBUG;
83             like( $dump, qr/\A$pattern\Z/ms, $_[0])
84               or note("line " . (caller)[2]);
85
86             local $TODO = $repeat_todo;
87             is($dump2, $dump, "$_[0] (unchanged by dump)")
88               or note("line " . (caller)[2]);
89
90             close(IN);
91
92             return $1;
93         } else {
94             die "$0: failed to open peek$$: !\n";
95         }
96     } else {
97         die "$0: failed to create peek$$: $!\n";
98     }
99 }
100
101 our   $a;
102 our   $b;
103 my    $c;
104 local $d = 0;
105
106 END {
107     1 while unlink("peek$$");
108 }
109
110 do_test('assignment of immediate constant (string)',
111         $a = "foo",
112 'SV = PV\\($ADDR\\) at $ADDR
113   REFCNT = 1
114   FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
115   PV = $ADDR "foo"\\\0
116   CUR = 3
117   LEN = \\d+
118   COW_REFCNT = 1                                # $] >=5.019003
119 ');
120
121 do_test('immediate constant (string)',
122         "bar",
123 'SV = PV\\($ADDR\\) at $ADDR
124   REFCNT = 1
125   FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
126   PV = $ADDR "bar"\\\0
127   CUR = 3
128   LEN = \\d+
129   COW_REFCNT = 0                                # $] >=5.019003
130 ');
131
132 do_test('assignment of immediate constant (integer)',
133         $b = 123,
134 'SV = IV\\($ADDR\\) at $ADDR
135   REFCNT = 1
136   FLAGS = \\(IOK,pIOK\\)
137   IV = 123');
138
139 do_test('immediate constant (integer)',
140         456,
141 'SV = IV\\($ADDR\\) at $ADDR
142   REFCNT = 1
143   FLAGS = \\(.*IOK,READONLY,pIOK\\)
144   IV = 456');
145
146 do_test('assignment of immediate constant (integer)',
147         $c = 456,
148 'SV = IV\\($ADDR\\) at $ADDR
149   REFCNT = 1
150   FLAGS = \\($PADMY,IOK,pIOK\\)
151   IV = 456');
152
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.
158 my $type = do_test('result of addition',
159         $c + $d,
160 'SV = ([NI])V\\($ADDR\\) at $ADDR
161   REFCNT = 1
162   FLAGS = \\(PADTMP,\1OK,p\1OK\\)               # $] < 5.019003
163   FLAGS = \\(\1OK,p\1OK\\)                      # $] >=5.019003
164   \1V = 456');
165
166 ($d = "789") += 0.1;
167
168 do_test('floating point value',
169        $d,
170        $] < 5.019003
171         || $Config{ccflags} =~ /-DPERL_(?:NO_COW|OLD_COPY_ON_WRITE)/
172        ?
173 'SV = PVNV\\($ADDR\\) at $ADDR
174   REFCNT = 1
175   FLAGS = \\(NOK,pNOK\\)
176   IV = \d+
177   NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
178   PV = $ADDR "789"\\\0
179   CUR = 3
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');
188
189 do_test('integer constant',
190         0xabcd,
191 'SV = IV\\($ADDR\\) at $ADDR
192   REFCNT = 1
193   FLAGS = \\(.*IOK,READONLY,pIOK\\)
194   IV = 43981');
195
196 do_test('undef',
197         undef,
198 'SV = NULL\\(0x0\\) at $ADDR
199   REFCNT = 1
200   FLAGS = \\(\\)');
201
202 do_test('reference to scalar',
203         \$a,
204 'SV = $RV\\($ADDR\\) at $ADDR
205   REFCNT = 1
206   FLAGS = \\(ROK\\)
207   RV = $ADDR
208   SV = PV\\($ADDR\\) at $ADDR
209     REFCNT = 2
210     FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
211     PV = $ADDR "foo"\\\0
212     CUR = 3
213     LEN = \\d+
214     COW_REFCNT = 1                              # $] >=5.019003
215 ');
216
217 my $c_pattern;
218 if ($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 }
233 do_test('reference to array',
234        [$b,$c],
235 'SV = $RV\\($ADDR\\) at $ADDR
236   REFCNT = 1
237   FLAGS = \\(ROK\\)
238   RV = $ADDR
239   SV = PVAV\\($ADDR\\) at $ADDR
240     REFCNT = 1
241     FLAGS = \\(\\)
242     IV = 0                                      # $] < 5.009
243     NV = 0                                      # $] < 5.009
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
254     Elt No. 1' . $c_pattern);
255
256 do_test('reference to hash',
257        {$b=>$c},
258 'SV = $RV\\($ADDR\\) at $ADDR
259   REFCNT = 1
260   FLAGS = \\(ROK\\)
261   RV = $ADDR
262   SV = PVHV\\($ADDR\\) at $ADDR
263     REFCNT = [12]
264     FLAGS = \\(SHAREKEYS\\)
265     IV = 1                                      # $] < 5.009
266     NV = $FLOAT                                 # $] < 5.009
267     ARRAY = $ADDR  \\(0:7, 1:1\\)
268     hash quality = 100.0%
269     KEYS = 1
270     FILL = 1
271     MAX = 7
272     Elt "123" HASH = $ADDR' . $c_pattern,
273         '',
274         $] > 5.009 && $] < 5.015
275          && 'The hash iterator used in dump.c sets the OOK flag');
276
277 do_test('reference to anon sub with empty prototype',
278         sub(){@_},
279 'SV = $RV\\($ADDR\\) at $ADDR
280   REFCNT = 1
281   FLAGS = \\(ROK\\)
282   RV = $ADDR
283   SV = PVCV\\($ADDR\\) at $ADDR
284     REFCNT = 2
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
287     IV = 0                                      # $] < 5.009
288     NV = 0                                      # $] < 5.009
289     PROTOTYPE = ""
290     COMP_STASH = $ADDR\\t"main"
291     START = $ADDR ===> \\d+
292     ROOT = $ADDR
293     XSUB = 0x0                                  # $] < 5.009
294     XSUBANY = 0                                 # $] < 5.009
295     GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
296     FILE = ".*\\b(?i:peek\\.t)"
297     DEPTH = 0(?:
298     MUTEXP = $ADDR
299     OWNER = $ADDR)?
300     FLAGS = 0x404                               # $] < 5.009
301     FLAGS = 0x490               # $] >= 5.009 && ($] < 5.015 || !thr)
302     FLAGS = 0x1490                              # $] >= 5.015 && thr
303     OUTSIDE_SEQ = \\d+
304     PADLIST = $ADDR
305     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
306     OUTSIDE = $ADDR \\(MAIN\\)');
307
308 do_test('reference to named subroutine without prototype',
309         \&do_test,
310 'SV = $RV\\($ADDR\\) at $ADDR
311   REFCNT = 1
312   FLAGS = \\(ROK\\)
313   RV = $ADDR
314   SV = PVCV\\($ADDR\\) at $ADDR
315     REFCNT = (3|4)
316     FLAGS = \\((?:HASEVAL)?\\)                  # $] < 5.015 || !thr
317     FLAGS = \\(DYNFILE(?:,HASEVAL)?\\)          # $] >= 5.015 && thr
318     IV = 0                                      # $] < 5.009
319     NV = 0                                      # $] < 5.009
320     COMP_STASH = $ADDR\\t"main"
321     START = $ADDR ===> \\d+
322     ROOT = $ADDR
323     XSUB = 0x0                                  # $] < 5.009
324     XSUBANY = 0                                 # $] < 5.009
325     GVGV::GV = $ADDR\\t"main" :: "do_test"
326     FILE = ".*\\b(?i:peek\\.t)"
327     DEPTH = 1(?:
328     MUTEXP = $ADDR
329     OWNER = $ADDR)?
330     FLAGS = 0x(?:400)?0                         # $] < 5.015 || !thr
331     FLAGS = 0x[145]000                          # $] >= 5.015 && thr
332     OUTSIDE_SEQ = \\d+
333     PADLIST = $ADDR
334     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
335        \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$todo"
336        \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$repeat_todo"
337        \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
338       \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG"                       # $] < 5.009
339       \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0     # $] >= 5.009
340       \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
341       \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2"
342     OUTSIDE = $ADDR \\(MAIN\\)');
343
344 if ($] >= 5.011) {
345 do_test('reference to regexp',
346         qr(tic),
347 'SV = $RV\\($ADDR\\) at $ADDR
348   REFCNT = 1
349   FLAGS = \\(ROK\\)
350   RV = $ADDR
351   SV = REGEXP\\($ADDR\\) at $ADDR
352     REFCNT = 1
353     FLAGS = \\(OBJECT,POK,FAKE,pPOK\\)          # $] < 5.017006
354     FLAGS = \\(OBJECT,FAKE\\)                   # $] >= 5.017006
355     PV = $ADDR "\\(\\?\\^:tic\\)"
356     CUR = 8
357     LEN = 0                                     # $] < 5.017006
358     STASH = $ADDR\\t"Regexp"'
359 . ($] < 5.013 ? '' :
360 '
361     COMPFLAGS = 0x0 \(\)
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
371     SUBLEN = 0
372     SUBOFFSET = 0
373     SUBCOFFSET = 0
374     SUBBEG = 0x0
375     ENGINE = $ADDR
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)?') . '
405     PAREN_NAMES = 0x0
406     SUBSTRS = $ADDR
407     PPRIVATE = $ADDR
408     OFFS = $ADDR
409     QR_ANONCV = 0x0(?:
410     SAVED_COPY = 0x0)?'
411 ));
412 } else {
413 do_test('reference to regexp',
414         qr(tic),
415 'SV = $RV\\($ADDR\\) at $ADDR
416   REFCNT = 1
417   FLAGS = \\(ROK\\)
418   RV = $ADDR
419   SV = PVMG\\($ADDR\\) at $ADDR
420     REFCNT = 1
421     FLAGS = \\(OBJECT,SMG\\)
422     IV = 0
423     NV = 0
424     PV = 0
425     MAGIC = $ADDR
426       MG_VIRTUAL = $ADDR
427       MG_TYPE = PERL_MAGIC_qr\(r\)
428       MG_OBJ = $ADDR
429         PAT = "\(\?^:tic\)"                     # $] >= 5.009
430         REFCNT = 2                              # $] >= 5.009
431     STASH = $ADDR\\t"Regexp"');
432 }
433
434 do_test('reference to blessed hash',
435         (bless {}, "Tac"),
436 'SV = $RV\\($ADDR\\) at $ADDR
437   REFCNT = 1
438   FLAGS = \\(ROK\\)
439   RV = $ADDR
440   SV = PVHV\\($ADDR\\) at $ADDR
441     REFCNT = [12]
442     FLAGS = \\(OBJECT,SHAREKEYS\\)
443     IV = 0                                      # $] < 5.009
444     NV = 0                                      # $] < 5.009
445     STASH = $ADDR\\t"Tac"
446     ARRAY = 0x0
447     KEYS = 0
448     FILL = 0
449     MAX = 7', '',
450         $] > 5.009
451         ? $] >= 5.015
452              ? 0
453              : 'The hash iterator used in dump.c sets the OOK flag'
454         : "Something causes the HV's array to become allocated");
455
456 do_test('typeglob',
457         *a,
458 'SV = PVGV\\($ADDR\\) at $ADDR
459   REFCNT = 5
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
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
481     GPFLAGS = 0x0                               # $] < 5.009
482     LINE = \\d+
483     FILE = ".*\\b(?i:peek\\.t)"
484     FLAGS = $ADDR
485     EGV = $ADDR\\t"a"');
486
487 if (ord('A') == 193) {
488 do_test('string with Unicode',
489         chr(256).chr(0).chr(512),
490 'SV = PV\\($ADDR\\) at $ADDR
491   REFCNT = 1
492   FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)     # $] < 5.019003
493   FLAGS = \\((?:$PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\)   # $] >=5.019003
494   PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
495   CUR = 5
496   LEN = \\d+
497   COW_REFCNT = 1                                        # $] >=5.019003
498 ');
499 } else {
500 do_test('string with Unicode',
501         chr(256).chr(0).chr(512),
502 'SV = PV\\($ADDR\\) at $ADDR
503   REFCNT = 1
504   FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)     # $] < 5.019003
505   FLAGS = \\((?:$PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\)   # $] >=5.019003
506   PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
507   CUR = 5
508   LEN = \\d+
509   COW_REFCNT = 1                                        # $] >=5.019003
510 ');
511 }
512
513 if (ord('A') == 193) {
514 do_test('reference to hash containing Unicode',
515         {chr(256)=>chr(512)},
516 'SV = $RV\\($ADDR\\) at $ADDR
517   REFCNT = 1
518   FLAGS = \\(ROK\\)
519   RV = $ADDR
520   SV = PVHV\\($ADDR\\) at $ADDR
521     REFCNT = [12]
522     FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
523     UV = 1                                      # $] < 5.009
524     NV = $FLOAT                                 # $] < 5.009
525     ARRAY = $ADDR  \\(0:7, 1:1\\)
526     hash quality = 100.0%
527     KEYS = 1
528     FILL = 1
529     MAX = 7
530     Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
531     SV = PV\\($ADDR\\) at $ADDR
532       REFCNT = 1
533       FLAGS = \\(POK,(?:IsCOW,)?pPOK,UTF8\\)
534       PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
535       CUR = 2
536       LEN = \\d+
537       COW_REFCNT = 1                            # $] < 5.009
538 ',      '',
539         $] > 5.009
540         ? $] >= 5.015
541             ?  0
542             : 'The hash iterator used in dump.c sets the OOK flag'
543         : 'sv_length has been called on the element, and cached the result in MAGIC');
544 } else {
545 do_test('reference to hash containing Unicode',
546         {chr(256)=>chr(512)},
547 'SV = $RV\\($ADDR\\) at $ADDR
548   REFCNT = 1
549   FLAGS = \\(ROK\\)
550   RV = $ADDR
551   SV = PVHV\\($ADDR\\) at $ADDR
552     REFCNT = [12]
553     FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
554     UV = 1                                      # $] < 5.009
555     NV = 0                                      # $] < 5.009
556     ARRAY = $ADDR  \\(0:7, 1:1\\)
557     hash quality = 100.0%
558     KEYS = 1
559     FILL = 1
560     MAX = 7
561     Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
562     SV = PV\\($ADDR\\) at $ADDR
563       REFCNT = 1
564       FLAGS = \\(POK,(?:IsCOW,)?pPOK,UTF8\\)
565       PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
566       CUR = 2
567       LEN = \\d+
568       COW_REFCNT = 1                            # $] >= 5.019003
569 ',      '',
570         $] > 5.009
571         ? $] >= 5.015
572             ?  0
573             : 'The hash iterator used in dump.c sets the OOK flag'
574         : 'sv_length has been called on the element, and cached the result in MAGIC');
575 }
576
577 my $x="";
578 $x=~/.??/g;
579 do_test('scalar with pos magic',
580         $x,
581 'SV = PVMG\\($ADDR\\) at $ADDR
582   REFCNT = 1
583   FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?pPOK\\)
584   IV = \d+
585   NV = 0
586   PV = $ADDR ""\\\0
587   CUR = 0
588   LEN = \d+
589   COW_REFCNT = [12]
590   MAGIC = $ADDR
591     MG_VIRTUAL = &PL_vtbl_mglob
592     MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
593     MG_FLAGS = 0x01
594       MINMATCH');
595
596 #
597 # TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
598 # environment variables may be invisibly case-forced, hence the (?i:PATH)
599 # C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
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)?
602 # VMS is setting FAKE and READONLY flags.  What VMS uses for storing
603 # ENV hashes is also not always null terminated.
604 #
605 if (${^TAINT}) {
606   do_test('tainted value in %ENV',
607           $ENV{PATH}=@ARGV,  # scalar(@ARGV) is a handy known tainted value
608 'SV = PVMG\\($ADDR\\) at $ADDR
609   REFCNT = 1
610   FLAGS = \\(GMG,SMG,RMG(?:,POK)?(?:,pIOK)?,pPOK\\)
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\\)
619 (?:    MG_FLAGS = 0x01
620       TAINTEDDIR
621 )?    MG_LEN = -?\d+
622     MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
623     SV = PV(?:IV)?\\($ADDR\\) at $ADDR
624       REFCNT = \d+
625       FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
626 (?:      IV = 0
627 )?      PV = $ADDR "(?i:PATH)"(?:\\\0)?
628       CUR = \d+
629       LEN = \d+)
630   MAGIC = $ADDR
631     MG_VIRTUAL = &PL_vtbl_taint
632     MG_TYPE = PERL_MAGIC_taint\\(t\\)');
633 }
634
635 do_test('blessed reference',
636         bless(\\undef, 'Foobar'),
637 'SV = $RV\\($ADDR\\) at $ADDR
638   REFCNT = 1
639   FLAGS = \\(ROK\\)
640   RV = $ADDR
641   SV = PVMG\\($ADDR\\) at $ADDR
642     REFCNT = 2
643     FLAGS = \\(OBJECT,ROK\\)
644     IV = -?\d+
645     NV = $FLOAT
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"');
654
655 sub const () {
656     "Perl rules";
657 }
658
659 do_test('constant subroutine',
660         \&const,
661 'SV = $RV\\($ADDR\\) at $ADDR
662   REFCNT = 1
663   FLAGS = \\(ROK\\)
664   RV = $ADDR
665   SV = PVCV\\($ADDR\\) at $ADDR
666     REFCNT = (2)
667     FLAGS = \\(POK,pPOK,CONST,ISXSUB\\)         # $] < 5.015
668     FLAGS = \\(POK,pPOK,CONST,DYNFILE,ISXSUB\\) # $] >= 5.015
669     IV = 0                                      # $] < 5.009
670     NV = 0                                      # $] < 5.009
671     PROTOTYPE = ""
672     COMP_STASH = 0x0
673     ROOT = 0x0                                  # $] < 5.009
674     XSUB = $ADDR
675     XSUBANY = $ADDR \\(CONST SV\\)
676     SV = PV\\($ADDR\\) at $ADDR
677       REFCNT = 1
678       FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
679       PV = $ADDR "Perl rules"\\\0
680       CUR = 10
681       LEN = \\d+
682       COW_REFCNT = 0                            # $] >=5.019003
683     GVGV::GV = $ADDR\\t"main" :: "const"
684     FILE = ".*\\b(?i:peek\\.t)"
685     DEPTH = 0(?:
686     MUTEXP = $ADDR
687     OWNER = $ADDR)?
688     FLAGS = 0x200                               # $] < 5.009
689     FLAGS = 0xc00                               # $] >= 5.009 && $] < 5.013
690     FLAGS = 0xc                                 # $] >= 5.013 && $] < 5.015
691     FLAGS = 0x100c                              # $] >= 5.015
692     OUTSIDE_SEQ = 0
693     PADLIST = 0x0
694     OUTSIDE = 0x0 \\(null\\)'); 
695
696 do_test('isUV should show on PVMG',
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');
704
705 do_test('IO',
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\\)
714     IV = 0                                      # $] < 5.011
715     NV = 0                                      # $] < 5.011
716     STASH = $ADDR\s+"IO::File"
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
727     SUBPROCESS = 0                              # $] < 5.009
728     TYPE = \'>\'
729     FLAGS = 0x4');
730
731 do_test('FORMAT',
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
739     FLAGS = \\(\\)                              # $] < 5.015 || !thr
740     FLAGS = \\(DYNFILE\\)                       # $] >= 5.015 && thr
741     IV = 0                                      # $] < 5.009
742     NV = 0                                      # $] < 5.009
743 (?:    PV = 0
744 )?    COMP_STASH = 0x0
745     START = $ADDR ===> \\d+
746     ROOT = $ADDR
747     XSUB = 0x0                                  # $] < 5.009
748     XSUBANY = 0                                 # $] < 5.009
749     GVGV::GV = $ADDR\\t"main" :: "PIE"
750     FILE = ".*\\b(?i:peek\\.t)"(?:
751     DEPTH = 0)?(?:
752     MUTEXP = $ADDR
753     OWNER = $ADDR)?
754     FLAGS = 0x0                                 # $] < 5.015 || !thr
755     FLAGS = 0x1000                              # $] >= 5.015 && thr
756     OUTSIDE_SEQ = \\d+
757     LINES = 0                                   # $] < 5.017_003
758     PADLIST = $ADDR
759     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
760     OUTSIDE = $ADDR \\(MAIN\\)');
761
762 do_test('blessing to a class with embedded NUL characters',
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
769     REFCNT = [12]
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
777     MAX = 7', '',
778         $] > 5.009
779         ? $] >= 5.015
780             ?  0
781             : 'The hash iterator used in dump.c sets the OOK flag'
782         : "Something causes the HV's array to become allocated");
783
784 do_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
797     FILL = 0 \(cached = 0\)
798     MAX = 7
799     RITER = -1
800     EITER = 0x0
801     RAND = $ADDR
802     NAME = "RWOM"
803     ENAME = "RWOM"                              # $] > 5.012
804 ');
805
806 *KLANK:: = \%RWOM::;
807
808 do_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
821     FILL = 0 \(cached = 0\)
822     MAX = 7
823     RITER = -1
824     EITER = 0x0
825     RAND = $ADDR
826     NAME = "RWOM"
827     NAMECOUNT = 2                               # $] > 5.012
828     ENAME = "RWOM", "KLANK"                     # $] > 5.012
829 ');
830
831 undef %RWOM::;
832
833 do_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
841     FLAGS = \\(OOK,SHAREKEYS\\)                 # $] < 5.017
842     FLAGS = \\(OOK,OVERLOAD,SHAREKEYS\\)        # $] >=5.017
843     IV = 1                                      # $] < 5.009
844     NV = $FLOAT                                 # $] < 5.009
845     ARRAY = $ADDR
846     KEYS = 0
847     FILL = 0 \(cached = 0\)
848     MAX = 7
849     RITER = -1
850     EITER = 0x0
851     RAND = $ADDR
852     NAMECOUNT = -3                              # $] > 5.012
853     ENAME = "RWOM", "KLANK"                     # $] > 5.012
854 ');
855
856 my %small = ("Perl", "Rules", "Beer", "Foamy");
857 my $b = %small;
858 do_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
877       FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
878       PV = $ADDR "(?:Rules|Foamy)"\\\0
879       CUR = \d+
880       LEN = \d+
881       COW_REFCNT = 1                            # $] >=5.019003
882 ){2}');
883
884 $b = keys %small;
885
886 do_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
908       FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
909       PV = $ADDR "(?:Rules|Foamy)"\\\0
910       CUR = \d+
911       LEN = \d+
912       COW_REFCNT = 1                            # $] >=5.019003
913 ){2}');
914
915 $b = %small;
916
917 do_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
939       FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
940       PV = $ADDR "(?:Rules|Foamy)"\\\0
941       CUR = \d+
942       LEN = \d+
943       COW_REFCNT = 1                            # $] >=5.019003
944 ){2}');
945
946 # This should immediately start with the FILL cached correctly.
947 my %large = (0..1999);
948 $b = %large;
949 do_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
971 SKIP: {
972     skip "Not built with usemymalloc", 2
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     my $y;
978     ok eval { fill_mstats($y); 1 }, 'fill_mstats on undef scalar';
979 }
980
981 # This is more a test of fbm_compile/pp_study (non) interaction than dumping
982 # prowess, but short of duplicating all the gubbins of this file, I can't see
983 # a way to make a better place for it:
984
985 use constant {
986     perl => 'rules',
987     beer => 'foamy',
988 };
989
990 unless ($Config{useithreads}) {
991     # These end up as copies in pads under ithreads, which rather defeats the
992     # the point of what we're trying to test here.
993
994     do_test('regular string constant', perl,
995 'SV = PV\\($ADDR\\) at $ADDR
996   REFCNT = 5
997   FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
998   PV = $ADDR "rules"\\\0
999   CUR = 5
1000   LEN = \d+
1001   COW_REFCNT = 0                                # $] >=5.019003
1002 ');
1003
1004     eval 'index "", perl';
1005
1006     # FIXME - really this shouldn't say EVALED. It's a false posistive on
1007     # 0x40000000 being used for several things, not a flag for "I'm in a string
1008     # eval"
1009
1010     do_test('string constant now an FBM', perl,
1011 'SV = PVMG\\($ADDR\\) at $ADDR
1012   REFCNT = 5
1013   FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
1014   PV = $ADDR "rules"\\\0
1015   CUR = 5
1016   LEN = \d+
1017   COW_REFCNT = 0                                # $] >=5.019003
1018   MAGIC = $ADDR
1019     MG_VIRTUAL = &PL_vtbl_regexp
1020     MG_TYPE = PERL_MAGIC_bm\\(B\\)
1021     MG_LEN = 256
1022     MG_PTR = $ADDR "(?:\\\\\d){256}"
1023   RARE = \d+                                    # $] < 5.019002
1024   PREVIOUS = 1                                  # $] < 5.019002
1025   USEFUL = 100
1026 ');
1027
1028     is(study perl, '', "Not allowed to study an FBM");
1029
1030     do_test('string constant still an FBM', perl,
1031 'SV = PVMG\\($ADDR\\) at $ADDR
1032   REFCNT = 5
1033   FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
1034   PV = $ADDR "rules"\\\0
1035   CUR = 5
1036   LEN = \d+
1037   COW_REFCNT = 0                                # $] >=5.019003
1038   MAGIC = $ADDR
1039     MG_VIRTUAL = &PL_vtbl_regexp
1040     MG_TYPE = PERL_MAGIC_bm\\(B\\)
1041     MG_LEN = 256
1042     MG_PTR = $ADDR "(?:\\\\\d){256}"
1043   RARE = \d+                                    # $] < 5.019002
1044   PREVIOUS = 1                                  # $] < 5.019002
1045   USEFUL = 100
1046 ');
1047
1048     do_test('regular string constant', beer,
1049 'SV = PV\\($ADDR\\) at $ADDR
1050   REFCNT = 6
1051   FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
1052   PV = $ADDR "foamy"\\\0
1053   CUR = 5
1054   LEN = \d+
1055   COW_REFCNT = 0                                # $] >=5.019003
1056 ');
1057
1058     is(study beer, 1, "Our studies were successful");
1059
1060     do_test('string constant quite unaffected', beer, 'SV = PV\\($ADDR\\) at $ADDR
1061   REFCNT = 6
1062   FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
1063   PV = $ADDR "foamy"\\\0
1064   CUR = 5
1065   LEN = \d+
1066   COW_REFCNT = 0                                # $] >=5.019003
1067 ');
1068
1069     my $want = 'SV = PVMG\\($ADDR\\) at $ADDR
1070   REFCNT = 6
1071   FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
1072   PV = $ADDR "foamy"\\\0
1073   CUR = 5
1074   LEN = \d+
1075   COW_REFCNT = 0                                # $] >=5.019003
1076   MAGIC = $ADDR
1077     MG_VIRTUAL = &PL_vtbl_regexp
1078     MG_TYPE = PERL_MAGIC_bm\\(B\\)
1079     MG_LEN = 256
1080     MG_PTR = $ADDR "(?:\\\\\d){256}"
1081   RARE = \d+                                    # $] < 5.019002
1082   PREVIOUS = \d+                                # $] < 5.019002
1083   USEFUL = 100
1084 ';
1085
1086     is (eval 'index "not too foamy", beer', 8, 'correct index');
1087
1088     do_test('string constant now FBMed', beer, $want);
1089
1090     my $pie = 'good';
1091
1092     is(study $pie, 1, "Our studies were successful");
1093
1094     do_test('string constant still FBMed', beer, $want);
1095
1096     do_test('second string also unaffected', $pie, 'SV = PV\\($ADDR\\) at $ADDR
1097   REFCNT = 1
1098   FLAGS = \\(PADMY,POK,pPOK\\)
1099   PV = $ADDR "good"\\\0
1100   CUR = 4
1101   LEN = \d+
1102 ');
1103 }
1104
1105 # (One block of study tests removed when study was made a no-op.)
1106
1107 {
1108     open(OUT,">peek$$") or die "Failed to open peek $$: $!";
1109     open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
1110     DeadCode();
1111     open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
1112     pass "no crash with DeadCode";
1113     close OUT;
1114 }
1115
1116 do_test('UTF-8 in a regular expression',
1117         qr/\x{100}/,
1118 'SV = IV\($ADDR\) at $ADDR
1119   REFCNT = 1
1120   FLAGS = \(ROK\)
1121   RV = $ADDR
1122   SV = REGEXP\($ADDR\) at $ADDR
1123     REFCNT = 1
1124     FLAGS = \(OBJECT,FAKE,UTF8\)
1125     PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
1126     CUR = 13
1127     STASH = $ADDR       "Regexp"
1128     COMPFLAGS = 0x0 \(\)
1129     EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
1130     INTFLAGS = 0x0
1131     NPARENS = 0
1132     LASTPAREN = 0
1133     LASTCLOSEPAREN = 0
1134     MINLEN = 1
1135     MINLENRET = 1
1136     GOFS = 0
1137     PRE_PREFIX = 5
1138     SUBLEN = 0
1139     SUBOFFSET = 0
1140     SUBCOFFSET = 0
1141     SUBBEG = 0x0
1142     ENGINE = $ADDR
1143     MOTHER_RE = $ADDR'
1144 . ($] < 5.019003 ? '' : '
1145     SV = REGEXP\($ADDR\) at $ADDR
1146       REFCNT = 2
1147       FLAGS = \(UTF8\)
1148       PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
1149       CUR = 13
1150       COMPFLAGS = 0x0 \(\)
1151       EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
1152       INTFLAGS = 0x0
1153       NPARENS = 0
1154       LASTPAREN = 0
1155       LASTCLOSEPAREN = 0
1156       MINLEN = 1
1157       MINLENRET = 1
1158       GOFS = 0
1159       PRE_PREFIX = 5
1160       SUBLEN = 0
1161       SUBOFFSET = 0
1162       SUBCOFFSET = 0
1163       SUBBEG = 0x0
1164       ENGINE = $ADDR
1165       MOTHER_RE = 0x0
1166       PAREN_NAMES = 0x0
1167       SUBSTRS = $ADDR
1168       PPRIVATE = $ADDR
1169       OFFS = $ADDR
1170       QR_ANONCV = 0x0(?:
1171       SAVED_COPY = 0x0)?') . '
1172     PAREN_NAMES = 0x0
1173     SUBSTRS = $ADDR
1174     PPRIVATE = $ADDR
1175     OFFS = $ADDR
1176     QR_ANONCV = 0x0(?:
1177     SAVED_COPY = 0x0)?
1178 ');
1179
1180 { # perl #117793: Extend SvREFCNT* to work on any perl variable type
1181   my %hash;
1182   my $base_count = Devel::Peek::SvREFCNT(%hash);
1183   my $ref = \%hash;
1184   is(Devel::Peek::SvREFCNT(%hash), $base_count + 1, "SvREFCNT on non-scalar");
1185 }
1186
1187 done_testing();