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 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/m;
  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;
  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     FLAGS = 0x4
 211     PADLIST = $ADDR
 212     OUTSIDE = $ADDR \\(MAIN\\)');
 213
 214 do_test(14,
 215         \&do_test,
 216 'SV = RV\\($ADDR\\) at $ADDR
 217   REFCNT = 1
 218   FLAGS = \\(ROK\\)
 219   RV = $ADDR
 220   SV = PVCV\\($ADDR\\) at $ADDR
 221     REFCNT = 3
 222     FLAGS = \\(\\)
 223     IV = 0
 224     NV = 0
 225     COMP_STASH = $ADDR\\t"main"
 226     START = $ADDR ===> \\d+
 227     ROOT = $ADDR
 228     XSUB = 0x0
 229     XSUBANY = 0
 230     GVGV::GV = $ADDR\\t"main" :: "do_test"
 231     FILE = ".+\\b(?i:peek\\.t)"
 232     DEPTH = 1
 233     FLAGS = 0x0
 234     PADLIST = $ADDR
 235       \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
 236      \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
 237      \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
 238     OUTSIDE = $ADDR \\(MAIN\\)');
 239
 240 do_test(15,
 241         qr(tic),
 242 'SV = RV\\($ADDR\\) at $ADDR
 243   REFCNT = 1
 244   FLAGS = \\(ROK\\)
 245   RV = $ADDR
 246   SV = PVMG\\($ADDR\\) at $ADDR
 247     REFCNT = 1
 248     FLAGS = \\(OBJECT,RMG\\)
 249     IV = 0
 250     NV = 0
 251     PV = 0
 252     MAGIC = $ADDR
 253       MG_VIRTUAL = $ADDR
 254       MG_TYPE = \'r\'
 255       MG_OBJ = $ADDR
 256     STASH = $ADDR\\t"Regexp"');
 257
 258 do_test(16,
 259         (bless {}, "Tac"),
 260 'SV = RV\\($ADDR\\) at $ADDR
 261   REFCNT = 1
 262   FLAGS = \\(ROK\\)
 263   RV = $ADDR
 264   SV = PVHV\\($ADDR\\) at $ADDR
 265     REFCNT = 2
 266     FLAGS = \\(OBJECT,SHAREKEYS\\)
 267     IV = 0
 268     NV = 0
 269     STASH = $ADDR\\t"Tac"
 270     ARRAY = 0x0
 271     KEYS = 0
 272     FILL = 0
 273     MAX = 7
 274     RITER = -1
 275     EITER = 0x0');
 276
 277 do_test(17,
 278         *a,
 279 'SV = PVGV\\($ADDR\\) at $ADDR
 280   REFCNT = 5
 281   FLAGS = \\(GMG,SMG,MULTI\\)
 282   IV = 0
 283   NV = 0
 284   MAGIC = $ADDR
 285     MG_VIRTUAL = &PL_vtbl_glob
 286     MG_TYPE = \'\\*\'
 287     MG_OBJ = $ADDR
 288     MG_LEN = 1
 289     MG_PTR = $ADDR "a"
 290   NAME = "a"
 291   NAMELEN = 1
 292   GvSTASH = $ADDR\\t"main"
 293   GP = $ADDR
 294     SV = $ADDR
 295     REFCNT = 1
 296     IO = 0x0
 297     FORM = 0x0
 298     AV = 0x0
 299     HV = 0x0
 300     CV = 0x0
 301     CVGEN = 0x0
 302     GPFLAGS = 0x0
 303     LINE = \\d+
 304     FILE = ".+\\b(?i:peek\\.t)"
 305     FLAGS = $ADDR
 306     EGV = $ADDR\\t"a"');
 307
 308 END {
 309   unlink("peek$$");
 310 }