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