t/lib/peek.t

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