ext/Devel/Peek/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 = IV\\($ADDR\\) at $ADDR
  92   REFCNT = 1
  93   FLAGS = \\(PADTMP,IOK,pIOK\\)
  94   IV = 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(?:000+\d+)?|0999+\d+)
 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\\)
 114   IV = 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 = IV\\($ADDR\\) at $ADDR
 158       REFCNT = 1
 159       FLAGS = \\(IOK,pIOK\\)
 160       IV = 456');
 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 = 100.0%
 175     KEYS = 1
 176     FILL = 1
 177     MAX = 7
 178     RITER = -1
 179     EITER = 0x0
 180     Elt "123" HASH = $ADDR
 181     SV = IV\\($ADDR\\) at $ADDR
 182       REFCNT = 1
 183       FLAGS = \\(IOK,pIOK\\)
 184       IV = 456');
 185
 186 do_test(13,
 187         sub(){@_},
 188 'SV = RV\\($ADDR\\) at $ADDR
 189   REFCNT = 1
 190   FLAGS = \\(ROK\\)
 191   RV = $ADDR
 192   SV = PVCV\\($ADDR\\) at $ADDR
 193     REFCNT = 2
 194     FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
 195     IV = 0
 196     NV = 0
 197     PROTOTYPE = ""
 198     COMP_STASH = $ADDR\\t"main"
 199     START = $ADDR ===> \\d+
 200     ROOT = $ADDR
 201     XSUB = 0x0
 202     XSUBANY = 0
 203     GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
 204     FILE = ".*\\b(?i:peek\\.t)"
 205     DEPTH = 0
 206 (?:    MUTEXP = $ADDR
 207     OWNER = $ADDR
 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|4)
 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 (?:    MUTEXP = $ADDR
 232     OWNER = $ADDR
 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 = PERL_MAGIC_qr\(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(?:,IN_PAD)?\\)
 282   IV = 0
 283   NV = 0
 284   MAGIC = $ADDR
 285     MG_VIRTUAL = &PL_vtbl_glob
 286     MG_TYPE = PERL_MAGIC_glob\(\*\)
 287     MG_OBJ = $ADDR
 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 = $ADDR
 304     EGV = $ADDR\\t"a"');
 305
 306 END {
 307   1 while unlink("peek$$");
 308 }