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