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