Introduce t/lib/peek.t.

p4raw-id: //depot/cfgperl@6074

diff --git a/MANIFEST b/MANIFEST
index 1ac2cb3..b4bf9e0 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1320,6 +1320,7 @@ t/lib/open2.t             See if IPC::Open2 works
 t/lib/open3.t          See if IPC::Open3 works
 t/lib/ops.t            See if Opcode works
 t/lib/parsewords.t     See if Text::ParseWords works
+t/lib/peek.t           See if Devel::Peek works
 t/lib/ph.t             See if h2ph works
 t/lib/posix.t          See if POSIX works
 t/lib/safe1.t          See if Safe works

diff --git a/t/lib/peek.t b/t/lib/peek.t
new file mode 100644 (file)
index 0000000..fd6e474
--- /dev/null
+++ b/t/lib/peek.t
@@ -0,0 +1,296 @@
+use Devel::Peek;
+
+print "1..17\n";
+
+our $DEBUG = 0;
+
+sub do_test {
+    my $pattern = pop;
+    if (open(OUT,">peek$$")) {
+       open(STDERR,">&OUT");
+       Dump($_[1]);
+       close(OUT);
+       if (open(IN, "peek$$")) {
+           local $/;
+           $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
+           print $pattern, "\n" if $DEBUG;
+           my $dump = <IN>;
+           print $dump, "\n"    if $DEBUG;
+           print "not " unless $dump =~ /$pattern/m;
+           print "ok $_[0]\n";
+           close(IN);
+       } else {
+           die "$0: failed to open peek$$: !\n";
+       }
+    } else {
+       die "$0: failed to create peek$$: $!\n";
+    }
+}
+
+our   $a;
+our   $b;
+my    $c;
+local $d;
+
+do_test( 1,
+       $a = "foo",
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(POK,pPOK\\)
+  PV = $ADDR "foo"\\\0
+  CUR = 3
+  LEN = 4'
+       );
+
+do_test( 2,
+        "bar",
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(POK,READONLY,pPOK\\)
+  PV = $ADDR "bar"\\\0
+  CUR = 3
+  LEN = 4');
+
+do_test( 3,
+        $b = 123,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(IOK,pIOK\\)
+  IV = 123');
+
+do_test( 4,
+        456,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(IOK,READONLY,pIOK\\)
+  IV = 456');
+
+do_test( 5,
+        $c = 456,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
+  IV = 456');
+
+do_test( 6,
+        $c + $d,
+'SV = NV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(PADTMP,NOK,pNOK\\)
+  NV = 456');
+
+($d = "789") += 0.1;
+
+do_test( 7,
+       $d,
+'SV = PVNV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(NOK,pNOK\\)
+  IV = 0
+  NV = 789\\.1
+  PV = $ADDR "789"\\\0
+  CUR = 3
+  LEN = 4');
+
+do_test( 8,
+        0xabcd,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(IOK,READONLY,pIOK,IsUV\\)
+  UV = 43981');
+
+do_test( 9,
+        undef,
+'SV = NULL\\(0x0\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(\\)');
+
+do_test(10,
+        \$a,
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(POK,pPOK\\)
+    PV = $ADDR "foo"\\\0
+    CUR = 3
+    LEN = 4');
+
+do_test(11,
+       [$b,$c],
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVAV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(\\)
+    IV = 0
+    NV = 0
+    ARRAY = $ADDR
+    FILL = 1
+    MAX = 1
+    ARYLEN = 0x0
+    FLAGS = \\(REAL\\)
+    Elt No. 0
+    SV = IV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,pIOK\\)
+      IV = 123
+    Elt No. 1
+    SV = PVNV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
+      IV = 456
+      NV = 456
+      PV = 0');
+
+do_test(12,
+       {$b=>$c},
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(SHAREKEYS\\)
+    IV = 1
+    NV = 0
+    ARRAY = $ADDR  \\(0:7, 1:1\\)
+    hash quality = 150.0%
+    KEYS = 1
+    FILL = 1
+    MAX = 7
+    RITER = -1
+    EITER = 0x0
+    Elt "123" HASH = $ADDR
+    SV = PVNV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
+      IV = 456
+      NV = 456
+      PV = 0');
+
+do_test(13,
+        sub(){@_},
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVCV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
+    IV = 0
+    NV = 0
+    PROTOTYPE = ""
+    COMP_STASH = $ADDR\\t"main"
+    START = $ADDR ===> \\d+
+    ROOT = $ADDR
+    XSUB = 0x0
+    XSUBANY = 0
+    GVGV::GV = $ADDR\\t"main" :: "__ANON__"
+    FILE = ".+\\b(?i:peek\\.t)"
+    DEPTH = 0
+    FLAGS = 0x4
+    PADLIST = $ADDR
+    OUTSIDE = $ADDR \\(MAIN\\)');
+
+do_test(14,
+        \&do_test,
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVCV\\($ADDR\\) at $ADDR
+    REFCNT = 3
+    FLAGS = \\(\\)
+    IV = 0
+    NV = 0
+    COMP_STASH = $ADDR\\t"main"
+    START = $ADDR ===> \\d+
+    ROOT = $ADDR
+    XSUB = 0x0
+    XSUBANY = 0
+    GVGV::GV = $ADDR\\t"main" :: "do_test"
+    FILE = ".+\\b(?i:peek\\.t)"
+    DEPTH = 1
+    FLAGS = 0x0
+    PADLIST = $ADDR
+      1\\. $ADDR \\("\\$pattern" 49-57\\)
+     12\\. $ADDR \\(FAKE "\\$DEBUG" 0-51\\)
+     13\\. $ADDR \\("\\$dump" 50-51\\)
+    OUTSIDE = $ADDR \\(MAIN\\)');
+
+do_test(15,
+        qr(tic),
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVMG\\($ADDR\\) at $ADDR
+    REFCNT = 1
+    FLAGS = \\(OBJECT,RMG\\)
+    IV = 0
+    NV = 0
+    PV = 0
+    MAGIC = $ADDR
+      MG_VIRTUAL = $ADDR
+      MG_TYPE = \'r\'
+      MG_OBJ = $ADDR
+    STASH = $ADDR\\t"Regexp"');
+
+do_test(16,
+        (bless {}, "Tac"),
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(OBJECT,SHAREKEYS\\)
+    IV = 0
+    NV = 0
+    STASH = $ADDR\\t"Tac"
+    ARRAY = 0x0
+    KEYS = 0
+    FILL = 0
+    MAX = 7
+    RITER = -1
+    EITER = 0x0');
+
+do_test(17,
+       *a,
+'SV = PVGV\\($ADDR\\) at $ADDR
+  REFCNT = 5
+  FLAGS = \\(GMG,SMG,MULTI\\)
+  IV = 0
+  NV = 0
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_glob
+    MG_TYPE = \'\\*\'
+    MG_OBJ = $ADDR
+    MG_LEN = 1
+    MG_PTR = $ADDR "a"
+  NAME = "a"
+  NAMELEN = 1
+  GvSTASH = $ADDR\\t"main"
+  GP = $ADDR
+    SV = $ADDR
+    REFCNT = 1
+    IO = 0x0
+    FORM = 0x0  
+    AV = 0x0
+    HV = 0x0
+    CV = 0x0
+    CVGEN = 0x0
+    GPFLAGS = 0x0
+    LINE = 30
+    FILE = ".+\\b(?i:peek\\.t)"
+    FLAGS = 0x2
+    EGV = $ADDR\\t"a"');
+
+END {
+  unlink("peek$$");
+}