ext/XS-APItest/t/svpeek.t

   1 BEGIN {
   2     chdir 't' if -d 't';
   3     @INC = '../lib';
   4     push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
   5     require Config; import Config;
   6     if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
   7         print "1..0 # Skip: XS::APItest was not built\n";
   8         exit 0;
   9     }
  10 }
  11
  12 use strict;
  13 use warnings;
  14
  15 use Test::More tests => 50;
  16
  17 BEGIN { use_ok('XS::APItest') };
  18
  19 $| = 1;
  20
  21   is (DPeek ($/),    'PVMG("\n"\0)',            '$/');
  22   is (DPeek ($\),    'PVMG()',                  '$\\');
  23   is (DPeek ($.),    'PVMG()',                  '$.');
  24   is (DPeek ($,),    'UNDEF',                   '$,');
  25   is (DPeek ($;),    'PV("\34"\0)',             '$;');
  26   is (DPeek ($"),    'PV(" "\0)',               '$"');
  27   is (DPeek ($:),    'PVMG(" \n-"\0)',          '$:');
  28   is (DPeek ($~),    'PVMG()',                  '$~');
  29   is (DPeek ($^),    'PVMG()',                  '$^');
  30   is (DPeek ($=),    'PVMG()',                  '$=');
  31   is (DPeek ($-),    'PVMG()',                  '$-');
  32 like (DPeek ($!), qr'^PVMG\("',                 '$!');
  33 if ($^O eq 'VMS') {
  34   # VMS defines COMPLEX_STATUS and upgrades $? to PVLV
  35   is (DPeek ($?),    'PVLV()',                  '$?');
  36 } else {
  37   is (DPeek ($?),    'PVMG()',                  '$?');
  38 }
  39   is (DPeek ($|),    'PVMG(1)',                 '$|');
  40
  41   "abc" =~ m/(b)/;      # Don't know why these magic vars have this content
  42 like (DPeek ($1), qr'^PVMG\("',                 ' $1');
  43   is (DPeek ($`),    'PVMG()',                  ' $`');
  44   is (DPeek ($&),    'PVMG()',                  ' $&');
  45   is (DPeek ($'),    'PVMG()',                  " \$'");
  46
  47   is (DPeek (undef), 'SV_UNDEF',                'undef');
  48   is (DPeek (1),     'IV(1)',                   'constant 1');
  49   is (DPeek (""),    'PV(""\0)',                'constant ""');
  50   is (DPeek (1.),    'NV(1)',                   'constant 1.');
  51   is (DPeek (\1),    '\IV(1)',                  'constant \1');
  52   is (DPeek (\\1),   '\\\IV(1)',                'constant \\\1');
  53
  54   is (DPeek (\@ARGV),   '\AV()',                '\@ARGV');
  55   is (DPeek (\@INC),    '\AV()',                '\@INC');
  56   is (DPeek (\%INC),    '\HV()',                '\%INC');
  57   is (DPeek (*STDOUT),  'GV()',                 '*STDOUT');
  58   is (DPeek (sub {}),   '\CV(__ANON__)',        'sub {}');
  59
  60 { our ($VAR, @VAR, %VAR);
  61   open VAR, "<", $^X or die "Can't open $^X: $!";
  62   sub VAR {}
  63   format VAR =
  64 .
  65
  66   is (DPeek ( $VAR),    'UNDEF',                ' $VAR undef');
  67   is (DPeek (\$VAR),    '\UNDEF',               '\$VAR undef');
  68   $VAR = 1;
  69   is (DPeek ($VAR),     'IV(1)',                ' $VAR 1');
  70   is (DPeek (\$VAR),    '\IV(1)',               '\$VAR 1');
  71   $VAR = "";
  72   is (DPeek ($VAR),     'PVIV(""\0)',           ' $VAR ""');
  73   is (DPeek (\$VAR),    '\PVIV(""\0)',          '\$VAR ""');
  74   $VAR = "\xa8";
  75   is (DPeek ($VAR),     'PVIV("\250"\0)',       ' $VAR "\xa8"');
  76   is (DPeek (\$VAR),    '\PVIV("\250"\0)',      '\$VAR "\xa8"');
  77   SKIP: {
  78       $] <= 5.008001 and skip "UTF8 tests useless in this ancient perl version", 1;
  79       $VAR = "a\x0a\x{20ac}";
  80       is (DPeek ($VAR), 'PVIV("a\n\342\202\254"\0) [UTF8 "a\n\x{20ac}"]',
  81                                                   ' $VAR "a\x0a\x{20ac}"');
  82       }
  83   $VAR = sub { "VAR" };
  84   is (DPeek ($VAR),     '\CV(__ANON__)',        ' $VAR sub { "VAR" }');
  85   is (DPeek (\$VAR),    '\\\CV(__ANON__)',      '\$VAR sub { "VAR" }');
  86   $VAR = 0;
  87
  88   is (DPeek (\&VAR),    '\CV(VAR)',             '\&VAR');
  89   is (DPeek ( *VAR),    'GV()',                 ' *VAR');
  90
  91   is (DPeek (*VAR{GLOB}),       '\GV()',        ' *VAR{GLOB}');
  92 like (DPeek (*VAR{SCALAR}), qr'\\PV(IV|MG)\(0\)',' *VAR{SCALAR}');
  93   is (DPeek (*VAR{ARRAY}),      '\AV()',        ' *VAR{ARRAY}');
  94   is (DPeek (*VAR{HASH}),       '\HV()',        ' *VAR{HASH}');
  95   is (DPeek (*VAR{CODE}),       '\CV(VAR)',     ' *VAR{CODE}');
  96   is (DPeek (*VAR{IO}),         '\IO()',        ' *VAR{IO}');
  97   is (DPeek (*VAR{FORMAT}),$]<5.008?'SV_UNDEF':'\FM()',' *VAR{FORMAT}');
  98   }
  99
 100 1;