t/lib/peek.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require Config; import Config;
   7     if ($Config{'extensions'} !~ /\bPeek\b/) {
   8         print "1..0 # Skip: Devel::Peek was not built\n";
   9         exit 0;
  10     }
  11 }
  12
  13 use Devel::Peek;
  14
  15 print "1..17\n";
  16
  17 our $DEBUG = 0;
  18 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
  19
  20 sub do_test {
  21     my $pattern = pop;
  22     if (open(OUT,">peek$$")) {
  23         open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
  24         Dump($_[1]);
  25         open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
  26         close(OUT);
  27         if (open(IN, "peek$$")) {
  28             local $/;
  29             $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
  30             print $pattern, "\n" if $DEBUG;
  31             my $dump = <IN>;
  32             print $dump, "\n"    if $DEBUG;
  33             print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
  34             print "ok $_[0]\n";
  35             close(IN);
  36         } else {
  37             die "$0: failed to open peek$$: !\n";
  38         }
  39     } else {
  40         die "$0: failed to create peek$$: $!\n";
  41     }
  42 }
  43
  44 our   $a;
  45 our   $b;
  46 my    $c;
  47 local $d = 0;
  48
  49 do_test( 1,
  50         $a = "foo",
  51 'SV = PV\\($ADDR\\) at $ADDR
  52   REFCNT = 1
  53   FLAGS = \\(POK,pPOK\\)
  54   PV = $ADDR "foo"\\\0
  55   CUR = 3
  56   LEN = 4'
  57        );
  58
  59 do_test( 2,
  60         "bar",
  61 'SV = PV\\($ADDR\\) at $ADDR
  62   REFCNT = 1
  63   FLAGS = \\(.*POK,READONLY,pPOK\\)
  64   PV = $ADDR "bar"\\\0
  65   CUR = 3
  66   LEN = 4');
  67
  68 do_test( 3,
  69         $b = 123,
  70 'SV = IV\\($ADDR\\) at $ADDR
  71   REFCNT = 1
  72   FLAGS = \\(IOK,pIOK\\)
  73   IV = 123');
  74
  75 do_test( 4,
  76         456,
  77 'SV = IV\\($ADDR\\) at $ADDR
  78   REFCNT = 1
  79   FLAGS = \\(.*IOK,READONLY,pIOK\\)
  80   IV = 456');
  81
  82 do_test( 5,
  83         $c = 456,
  84 'SV = IV\\($ADDR\\) at $ADDR
  85   REFCNT = 1
  86   FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
  87   IV = 456');
  88
  89 do_test( 6,
  90         $c + $d,
  91 'SV = NV\\($ADDR\\) at $ADDR
  92   REFCNT = 1
  93   FLAGS = \\(PADTMP,NOK,pNOK\\)
  94   NV = 456');
  95
  96 ($d = "789") += 0.1;
  97
  98 do_test( 7,
  99        $d,
 100 'SV = PVNV\\($ADDR\\) at $ADDR
 101   REFCNT = 1
 102   FLAGS = \\(NOK,pNOK\\)
 103   IV = 0
 104   NV = 789\\.1
 105   PV = $ADDR "789"\\\0
 106   CUR = 3
 107   LEN = 4');
 108
 109 do_test( 8,
 110         0xabcd,
 111 'SV = IV\\($ADDR\\) at $ADDR
 112   REFCNT = 1
 113   FLAGS = \\(.*IOK,READONLY,pIOK,IsUV\\)
 114   UV = 43981');
 115
 116 do_test( 9,
 117         undef,
 118 'SV = NULL\\(0x0\\) at $ADDR
 119   REFCNT = 1
 120   FLAGS = \\(\\)');
 121
 122 do_test(10,
 123         \$a,
 124 'SV = RV\\($ADDR\\) at $ADDR
 125   REFCNT = 1
 126   FLAGS = \\(ROK\\)
 127   RV = $ADDR
 128   SV = PV\\($ADDR\\) at $ADDR
 129     REFCNT = 2
 130     FLAGS = \\(POK,pPOK\\)
 131     PV = $ADDR "foo"\\\0
 132     CUR = 3
 133     LEN = 4');
 134
 135 do_test(11,
 136        [$b,$c],
 137 'SV = RV\\($ADDR\\) at $ADDR
 138   REFCNT = 1
 139   FLAGS = \\(ROK\\)
 140   RV = $ADDR
 141   SV = PVAV\\($ADDR\\) at $ADDR
 142     REFCNT = 2
 143     FLAGS = \\(\\)
 144     IV = 0
 145     NV = 0
 146     ARRAY = $ADDR
 147     FILL = 1
 148     MAX = 1
 149     ARYLEN = 0x0
 150     FLAGS = \\(REAL\\)
 151     Elt No. 0
 152     SV = IV\\($ADDR\\) at $ADDR
 153       REFCNT = 1
 154       FLAGS = \\(IOK,pIOK\\)
 155       IV = 123
 156     Elt No. 1
 157     SV = PVNV\\($ADDR\\) at $ADDR
 158       REFCNT = 1
 159       FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
 160       IV = 456
 161       NV = 456
 162       PV = 0');
 163
 164 do_test(12,
 165        {$b=>$c},
 166 'SV = RV\\($ADDR\\) at $ADDR
 167   REFCNT = 1
 168   FLAGS = \\(ROK\\)
 169   RV = $ADDR
 170   SV = PVHV\\($ADDR\\) at $ADDR
 171     REFCNT = 2
 172     FLAGS = \\(SHAREKEYS\\)
 173     IV = 1
 174     NV = 0
 175     ARRAY = $ADDR  \\(0:7, 1:1\\)
 176     hash quality = 150.0%
 177     KEYS = 1
 178     FILL = 1
 179     MAX = 7
 180     RITER = -1
 181     EITER = 0x0
 182     Elt "123" HASH = $ADDR
 183     SV = PVNV\\($ADDR\\) at $ADDR
 184       REFCNT = 1
 185       FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
 186       IV = 456
 187       NV = 456
 188       PV = 0');
 189
 190 do_test(13,
 191         sub(){@_},
 192 'SV = RV\\($ADDR\\) at $ADDR
 193   REFCNT = 1
 194   FLAGS = \\(ROK\\)
 195   RV = $ADDR
 196   SV = PVCV\\($ADDR\\) at $ADDR
 197     REFCNT = 2
 198     FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
 199     IV = 0
 200     NV = 0
 201     PROTOTYPE = ""
 202     COMP_STASH = $ADDR\\t"main"
 203     START = $ADDR ===> \\d+
 204     ROOT = $ADDR
 205     XSUB = 0x0
 206     XSUBANY = 0
 207     GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
 208     FILE = ".*\\b(?i:peek\\.t)"
 209     DEPTH = 0
 210 (?:    MUTEXP = $ADDR
 211     OWNER = $ADDR
 212 )?    FLAGS = 0x4
 213     PADLIST = $ADDR
 214     OUTSIDE = $ADDR \\(MAIN\\)');
 215
 216 do_test(14,
 217         \&do_test,
 218 'SV = RV\\($ADDR\\) at $ADDR
 219   REFCNT = 1
 220   FLAGS = \\(ROK\\)
 221   RV = $ADDR
 222   SV = PVCV\\($ADDR\\) at $ADDR
 223     REFCNT = (3|4)
 224     FLAGS = \\(\\)
 225     IV = 0
 226     NV = 0
 227     COMP_STASH = $ADDR\\t"main"
 228     START = $ADDR ===> \\d+
 229     ROOT = $ADDR
 230     XSUB = 0x0
 231     XSUBANY = 0
 232     GVGV::GV = $ADDR\\t"main" :: "do_test"
 233     FILE = ".*\\b(?i:peek\\.t)"
 234     DEPTH = 1
 235 (?:    MUTEXP = $ADDR
 236     OWNER = $ADDR
 237 )?    FLAGS = 0x0
 238     PADLIST = $ADDR
 239       \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
 240      \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
 241      \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
 242     OUTSIDE = $ADDR \\(MAIN\\)');
 243
 244 do_test(15,
 245         qr(tic),
 246 'SV = RV\\($ADDR\\) at $ADDR
 247   REFCNT = 1
 248   FLAGS = \\(ROK\\)
 249   RV = $ADDR
 250   SV = PVMG\\($ADDR\\) at $ADDR
 251     REFCNT = 1
 252     FLAGS = \\(OBJECT,RMG\\)
 253     IV = 0
 254     NV = 0
 255     PV = 0
 256     MAGIC = $ADDR
 257       MG_VIRTUAL = $ADDR
 258       MG_TYPE = \'r\'
 259       MG_OBJ = $ADDR
 260     STASH = $ADDR\\t"Regexp"');
 261
 262 do_test(16,
 263         (bless {}, "Tac"),
 264 'SV = RV\\($ADDR\\) at $ADDR
 265   REFCNT = 1
 266   FLAGS = \\(ROK\\)
 267   RV = $ADDR
 268   SV = PVHV\\($ADDR\\) at $ADDR
 269     REFCNT = 2
 270     FLAGS = \\(OBJECT,SHAREKEYS\\)
 271     IV = 0
 272     NV = 0
 273     STASH = $ADDR\\t"Tac"
 274     ARRAY = 0x0
 275     KEYS = 0
 276     FILL = 0
 277     MAX = 7
 278     RITER = -1
 279     EITER = 0x0');
 280
 281 do_test(17,
 282         *a,
 283 'SV = PVGV\\($ADDR\\) at $ADDR
 284   REFCNT = 5
 285   FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
 286   IV = 0
 287   NV = 0
 288   MAGIC = $ADDR
 289     MG_VIRTUAL = &PL_vtbl_glob
 290     MG_TYPE = \'\\*\'
 291     MG_OBJ = $ADDR
 292   NAME = "a"
 293   NAMELEN = 1
 294   GvSTASH = $ADDR\\t"main"
 295   GP = $ADDR
 296     SV = $ADDR
 297     REFCNT = 1
 298     IO = 0x0
 299     FORM = 0x0
 300     AV = 0x0
 301     HV = 0x0
 302     CV = 0x0
 303     CVGEN = 0x0
 304     GPFLAGS = 0x0
 305     LINE = \\d+
 306     FILE = ".*\\b(?i:peek\\.t)"
 307     EGV = $ADDR\\t"a"');
 308
 309 END {
 310   1 while unlink("peek$$");
 311 }