t/lib/peek.t

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