This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Proper fix for CvOUTSIDE weak refcounting
[perl5.git] / ext / Devel / Peek / Peek.t
index 9be948c..a1ed214 100644 (file)
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -T
 
 BEGIN {
     chdir 't' if -d 't';
@@ -12,7 +12,7 @@ BEGIN {
 
 use Devel::Peek;
 
-print "1..19\n";
+print "1..22\n";
 
 our $DEBUG = 0;
 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
@@ -31,7 +31,7 @@ sub do_test {
            print $pattern, "\n" if $DEBUG;
            my $dump = <IN>;
            print $dump, "\n"    if $DEBUG;
-           print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
+           print "[$dump] vs [$pattern]\nnot " unless $dump =~ /\A$pattern\Z/ms;
            print "ok $_[0]\n";
            close(IN);
             return $1;
@@ -206,7 +206,7 @@ do_test(13,
   RV = $ADDR
   SV = PVCV\\($ADDR\\) at $ADDR
     REFCNT = 2
-    FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
+    FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
     IV = 0
     NV = 0
     PROTOTYPE = ""
@@ -220,8 +220,10 @@ do_test(13,
     DEPTH = 0
 (?:    MUTEXP = $ADDR
     OWNER = $ADDR
-)?    FLAGS = 0x4
+)?    FLAGS = 0x404
+    OUTSIDE_SEQ = \\d+
     PADLIST = $ADDR
+    PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
     OUTSIDE = $ADDR \\(MAIN\\)');
 
 do_test(14,
@@ -246,10 +248,12 @@ do_test(14,
 (?:    MUTEXP = $ADDR
     OWNER = $ADDR
 )?    FLAGS = 0x0
+    OUTSIDE_SEQ = \\d+
     PADLIST = $ADDR
-      \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
-     \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
-     \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
+    PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
+       \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
+      \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG"
+      \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
     OUTSIDE = $ADDR \\(MAIN\\)');
 
 do_test(15,
@@ -347,8 +351,8 @@ do_test(19,
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
     REFCNT = 2
-    FLAGS = \\(SHAREKEYS\\)
-    IV = 1
+    FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
+    UV = 1
     NV = $FLOAT
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%
@@ -357,7 +361,7 @@ do_test(19,
     MAX = 7
     RITER = -1
     EITER = $ADDR
-    Elt "\\\241\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
+    Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
     SV = PV\\($ADDR\\) at $ADDR
       REFCNT = 1
       FLAGS = \\(POK,pPOK,UTF8\\)
@@ -373,8 +377,8 @@ do_test(19,
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
     REFCNT = 2
-    FLAGS = \\(SHAREKEYS\\)
-    IV = 1
+    FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
+    UV = 1
     NV = 0
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%
@@ -392,6 +396,70 @@ do_test(19,
       LEN = \\d+');
 }
 
+my $x="";
+$x=~/.??/g;
+do_test(20,
+        $x,
+'SV = PVMG\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(PADBUSY,PADMY,SMG,POK,pPOK\\)
+  IV = 0
+  NV = 0
+  PV = $ADDR ""\\\0
+  CUR = 0
+  LEN = 1
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_mglob
+    MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
+    MG_FLAGS = 0x01
+      MINMATCH');
+
+#
+# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
+# environment variables may be invisibly case-forced, hence the (?i:PATH)
+#
+do_test(21,
+        $ENV{PATH}=@ARGV,  # scalar(@ARGV) is a handy known tainted value
+'SV = PVMG\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
+  IV = 0
+  NV = 0
+  PV = $ADDR "0"\\\0
+  CUR = 1
+  LEN = \d+
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_envelem
+    MG_TYPE = PERL_MAGIC_envelem\\(e\\)
+(?:    MG_FLAGS = 0x01
+      TAINTEDDIR
+)?    MG_LEN = 4
+    MG_PTR = $ADDR "(?i:PATH)"
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_taint
+    MG_TYPE = PERL_MAGIC_taint\\(t\\)');
+
 END {
   1 while unlink("peek$$");
 }
+
+# blessed refs
+do_test(22,
+       bless(\\undef, 'Foobar'),
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVMG\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(OBJECT,ROK\\)
+    IV = -?\d+
+    NV = $FLOAT
+    RV = $ADDR
+    SV = NULL\\(0x0\\) at $ADDR
+      REFCNT = \d+
+      FLAGS = \\(READONLY\\)
+    PV = $ADDR ""
+    CUR = 0
+    LEN = 0
+    STASH = $ADDR\s+"Foobar"');