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..19\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             return $1;
  37         } else {
  38             die "$0: failed to open peek$$: !\n";
  39         }
  40     } else {
  41         die "$0: failed to create peek$$: $!\n";
  42     }
  43 }
  44
  45 our   $a;
  46 our   $b;
  47 my    $c;
  48 local $d = 0;
  49
  50 do_test( 1,
  51         $a = "foo",
  52 'SV = PV\\($ADDR\\) at $ADDR
  53   REFCNT = 1
  54   FLAGS = \\(POK,pPOK\\)
  55   PV = $ADDR "foo"\\\0
  56   CUR = 3
  57   LEN = \\d+'
  58        );
  59
  60 do_test( 2,
  61         "bar",
  62 'SV = PV\\($ADDR\\) at $ADDR
  63   REFCNT = 1
  64   FLAGS = \\(.*POK,READONLY,pPOK\\)
  65   PV = $ADDR "bar"\\\0
  66   CUR = 3
  67   LEN = \\d+');
  68
  69 do_test( 3,
  70         $b = 123,
  71 'SV = IV\\($ADDR\\) at $ADDR
  72   REFCNT = 1
  73   FLAGS = \\(IOK,pIOK\\)
  74   IV = 123');
  75
  76 do_test( 4,
  77         456,
  78 'SV = IV\\($ADDR\\) at $ADDR
  79   REFCNT = 1
  80   FLAGS = \\(.*IOK,READONLY,pIOK\\)
  81   IV = 456');
  82
  83 do_test( 5,
  84         $c = 456,
  85 'SV = IV\\($ADDR\\) at $ADDR
  86   REFCNT = 1
  87   FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
  88   IV = 456');
  89
  90 # If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
  91 # where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
  92 # maths is done in floating point always, and this scalar will be an NV.
  93 # ([NI]) captures the type, referred to by \1 in this regexp and $type for
  94 # building subsequent regexps.
  95 my $type = do_test( 6,
  96         $c + $d,
  97 'SV = ([NI])V\\($ADDR\\) at $ADDR
  98   REFCNT = 1
  99   FLAGS = \\(PADTMP,\1OK,p\1OK\\)
 100   \1V = 456');
 101
 102 ($d = "789") += 0.1;
 103
 104 do_test( 7,
 105        $d,
 106 'SV = PVNV\\($ADDR\\) at $ADDR
 107   REFCNT = 1
 108   FLAGS = \\(NOK,pNOK\\)
 109   IV = 0
 110   NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
 111   PV = $ADDR "789"\\\0
 112   CUR = 3
 113   LEN = \\d+');
 114
 115 do_test( 8,
 116         0xabcd,
 117 'SV = IV\\($ADDR\\) at $ADDR
 118   REFCNT = 1
 119   FLAGS = \\(.*IOK,READONLY,pIOK\\)
 120   IV = 43981');
 121
 122 do_test( 9,
 123         undef,
 124 'SV = NULL\\(0x0\\) at $ADDR
 125   REFCNT = 1
 126   FLAGS = \\(\\)');
 127
 128 do_test(10,
 129         \$a,
 130 'SV = RV\\($ADDR\\) at $ADDR
 131   REFCNT = 1
 132   FLAGS = \\(ROK\\)
 133   RV = $ADDR
 134   SV = PV\\($ADDR\\) at $ADDR
 135     REFCNT = 2
 136     FLAGS = \\(POK,pPOK\\)
 137     PV = $ADDR "foo"\\\0
 138     CUR = 3
 139     LEN = \\d+');
 140
 141 my $c_pattern;
 142 if ($type eq 'N') {
 143   $c_pattern = '
 144     SV = PVNV\\($ADDR\\) at $ADDR
 145       REFCNT = 1
 146       FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
 147       IV = 456
 148       NV = 456
 149       PV = 0';
 150 } else {
 151   $c_pattern = '
 152     SV = IV\\($ADDR\\) at $ADDR
 153       REFCNT = 1
 154       FLAGS = \\(IOK,pIOK\\)
 155       IV = 456';
 156 }
 157 do_test(11,
 158        [$b,$c],
 159 'SV = RV\\($ADDR\\) at $ADDR
 160   REFCNT = 1
 161   FLAGS = \\(ROK\\)
 162   RV = $ADDR
 163   SV = PVAV\\($ADDR\\) at $ADDR
 164     REFCNT = 2
 165     FLAGS = \\(\\)
 166     IV = 0
 167     NV = 0
 168     ARRAY = $ADDR
 169     FILL = 1
 170     MAX = 1
 171     ARYLEN = 0x0
 172     FLAGS = \\(REAL\\)
 173     Elt No. 0
 174     SV = IV\\($ADDR\\) at $ADDR
 175       REFCNT = 1
 176       FLAGS = \\(IOK,pIOK\\)
 177       IV = 123
 178     Elt No. 1' . $c_pattern);
 179
 180 do_test(12,
 181        {$b=>$c},
 182 'SV = RV\\($ADDR\\) at $ADDR
 183   REFCNT = 1
 184   FLAGS = \\(ROK\\)
 185   RV = $ADDR
 186   SV = PVHV\\($ADDR\\) at $ADDR
 187     REFCNT = 2
 188     FLAGS = \\(SHAREKEYS\\)
 189     IV = 1
 190     NV = 0
 191     ARRAY = $ADDR  \\(0:7, 1:1\\)
 192     hash quality = 100.0%
 193     KEYS = 1
 194     FILL = 1
 195     MAX = 7
 196     RITER = -1
 197     EITER = 0x0
 198     Elt "123" HASH = $ADDR' . $c_pattern);
 199
 200 do_test(13,
 201         sub(){@_},
 202 'SV = RV\\($ADDR\\) at $ADDR
 203   REFCNT = 1
 204   FLAGS = \\(ROK\\)
 205   RV = $ADDR
 206   SV = PVCV\\($ADDR\\) at $ADDR
 207     REFCNT = 2
 208     FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
 209     IV = 0
 210     NV = 0
 211     PROTOTYPE = ""
 212     COMP_STASH = $ADDR\\t"main"
 213     START = $ADDR ===> \\d+
 214     ROOT = $ADDR
 215     XSUB = 0x0
 216     XSUBANY = 0
 217     GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
 218     FILE = ".*\\b(?i:peek\\.t)"
 219     DEPTH = 0
 220 (?:    MUTEXP = $ADDR
 221     OWNER = $ADDR
 222 )?    FLAGS = 0x4
 223     PADLIST = $ADDR
 224     OUTSIDE = $ADDR \\(MAIN\\)');
 225
 226 do_test(14,
 227         \&do_test,
 228 'SV = RV\\($ADDR\\) at $ADDR
 229   REFCNT = 1
 230   FLAGS = \\(ROK\\)
 231   RV = $ADDR
 232   SV = PVCV\\($ADDR\\) at $ADDR
 233     REFCNT = (3|4)
 234     FLAGS = \\(\\)
 235     IV = 0
 236     NV = 0
 237     COMP_STASH = $ADDR\\t"main"
 238     START = $ADDR ===> \\d+
 239     ROOT = $ADDR
 240     XSUB = 0x0
 241     XSUBANY = 0
 242     GVGV::GV = $ADDR\\t"main" :: "do_test"
 243     FILE = ".*\\b(?i:peek\\.t)"
 244     DEPTH = 1
 245 (?:    MUTEXP = $ADDR
 246     OWNER = $ADDR
 247 )?    FLAGS = 0x0
 248     PADLIST = $ADDR
 249       \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
 250      \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
 251      \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
 252     OUTSIDE = $ADDR \\(MAIN\\)');
 253
 254 do_test(15,
 255         qr(tic),
 256 'SV = RV\\($ADDR\\) at $ADDR
 257   REFCNT = 1
 258   FLAGS = \\(ROK\\)
 259   RV = $ADDR
 260   SV = PVMG\\($ADDR\\) at $ADDR
 261     REFCNT = 1
 262     FLAGS = \\(OBJECT,RMG\\)
 263     IV = 0
 264     NV = 0
 265     PV = 0
 266     MAGIC = $ADDR
 267       MG_VIRTUAL = $ADDR
 268       MG_TYPE = PERL_MAGIC_qr\(r\)
 269       MG_OBJ = $ADDR
 270     STASH = $ADDR\\t"Regexp"');
 271
 272 do_test(16,
 273         (bless {}, "Tac"),
 274 'SV = RV\\($ADDR\\) at $ADDR
 275   REFCNT = 1
 276   FLAGS = \\(ROK\\)
 277   RV = $ADDR
 278   SV = PVHV\\($ADDR\\) at $ADDR
 279     REFCNT = 2
 280     FLAGS = \\(OBJECT,SHAREKEYS\\)
 281     IV = 0
 282     NV = 0
 283     STASH = $ADDR\\t"Tac"
 284     ARRAY = 0x0
 285     KEYS = 0
 286     FILL = 0
 287     MAX = 7
 288     RITER = -1
 289     EITER = 0x0');
 290
 291 do_test(17,
 292         *a,
 293 'SV = PVGV\\($ADDR\\) at $ADDR
 294   REFCNT = 5
 295   FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
 296   IV = 0
 297   NV = 0
 298   MAGIC = $ADDR
 299     MG_VIRTUAL = &PL_vtbl_glob
 300     MG_TYPE = PERL_MAGIC_glob\(\*\)
 301     MG_OBJ = $ADDR
 302   NAME = "a"
 303   NAMELEN = 1
 304   GvSTASH = $ADDR\\t"main"
 305   GP = $ADDR
 306     SV = $ADDR
 307     REFCNT = 1
 308     IO = 0x0
 309     FORM = 0x0
 310     AV = 0x0
 311     HV = 0x0
 312     CV = 0x0
 313     CVGEN = 0x0
 314     GPFLAGS = 0x0
 315     LINE = \\d+
 316     FILE = ".*\\b(?i:peek\\.t)"
 317     FLAGS = $ADDR
 318     EGV = $ADDR\\t"a"');
 319
 320 if (ord('A') == 193) {
 321 do_test(18,
 322         chr(256).chr(0).chr(512),
 323 'SV = PV\\($ADDR\\) at $ADDR
 324   REFCNT = 1
 325   FLAGS = \\((?:PADBUSY,PADTMP,)?POK,READONLY,pPOK,UTF8\\)
 326   PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
 327   CUR = 5
 328   LEN = \\d+');
 329 } else {
 330 do_test(18,
 331         chr(256).chr(0).chr(512),
 332 'SV = PV\\($ADDR\\) at $ADDR
 333   REFCNT = 1
 334   FLAGS = \\((?:PADBUSY,PADTMP,)?POK,READONLY,pPOK,UTF8\\)
 335   PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
 336   CUR = 5
 337   LEN = \\d+');
 338 }
 339
 340 if (ord('A') == 193) {
 341 do_test(19,
 342         {chr(256)=>chr(512)},
 343 'SV = RV\\($ADDR\\) at $ADDR
 344   REFCNT = 1
 345   FLAGS = \\(ROK\\)
 346   RV = $ADDR
 347   SV = PVHV\\($ADDR\\) at $ADDR
 348     REFCNT = 2
 349     FLAGS = \\(SHAREKEYS\\)
 350     IV = 1
 351     NV = 0
 352     ARRAY = $ADDR  \\(0:7, 1:1\\)
 353     hash quality = 100.0%
 354     KEYS = 1
 355     FILL = 1
 356     MAX = 7
 357     RITER = -1
 358     EITER = $ADDR
 359     Elt "\\\241\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
 360     SV = PV\\($ADDR\\) at $ADDR
 361       REFCNT = 1
 362       FLAGS = \\(POK,pPOK,UTF8\\)
 363       PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
 364       CUR = 2
 365       LEN = \\d+');
 366 } else {
 367 do_test(19,
 368         {chr(256)=>chr(512)},
 369 'SV = RV\\($ADDR\\) at $ADDR
 370   REFCNT = 1
 371   FLAGS = \\(ROK\\)
 372   RV = $ADDR
 373   SV = PVHV\\($ADDR\\) at $ADDR
 374     REFCNT = 2
 375     FLAGS = \\(SHAREKEYS\\)
 376     IV = 1
 377     NV = 0
 378     ARRAY = $ADDR  \\(0:7, 1:1\\)
 379     hash quality = 100.0%
 380     KEYS = 1
 381     FILL = 1
 382     MAX = 7
 383     RITER = -1
 384     EITER = $ADDR
 385     Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
 386     SV = PV\\($ADDR\\) at $ADDR
 387       REFCNT = 1
 388       FLAGS = \\(POK,pPOK,UTF8\\)
 389       PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
 390       CUR = 2
 391       LEN = \\d+');
 392 }
 393
 394 END {
 395   1 while unlink("peek$$");
 396 }