t/lib/b.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     unshift @INC, '../lib';
   6 }
   7
   8 $|  = 1;
   9 use warnings;
  10 use strict;
  11 use Config;
  12
  13 print "1..10\n";
  14
  15 my $test = 1;
  16
  17 sub ok { print "ok $test\n"; $test++ }
  18
  19 use B::Deparse;
  20 my $deparse = B::Deparse->new() or print "not ";
  21 ok;
  22
  23 print "not " if "{\n    1;\n}" ne $deparse->coderef2text(sub {1});
  24 ok;
  25
  26 print "not " if "{\n    '???';\n    2;\n}" ne
  27                     $deparse->coderef2text(sub {1;2});
  28 ok;
  29
  30 print "not " if "{\n    \$test /= 2 if ++\$test;\n}" ne
  31                     $deparse->coderef2text(sub {++$test and $test/=2;});
  32 ok;
  33
  34 my $a;
  35 my $Is_VMS = $^O eq 'VMS';
  36 if ($Is_VMS) {
  37     $^X = "MCR $^X";
  38     $a = `$^X "-I../lib" "-MO=Deparse" -anle "1"`;
  39 }
  40 else {
  41     $a = `$^X -I../lib -MO=Deparse -anle 1 2>&1`;
  42 }
  43 $a =~ s/-e syntax OK\n//g;
  44 $b = <<'EOF';
  45
  46 LINE: while (defined($_ = <ARGV>)) {
  47     chomp $_;
  48     @F = split(/\s+/, $_, 0);
  49     '???'
  50 }
  51 continue {
  52     '???'
  53 }
  54
  55 EOF
  56 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
  57 ok;
  58
  59 #6
  60 if ($Is_VMS) {
  61     $a = `$^X "-I../lib" "-MO=Debug" -e "1"`;
  62 }
  63 else {
  64     $a = `$^X -I../lib -MO=Debug -e 1 2>&1`;
  65 }
  66 print "not " unless $a =~
  67 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
  68 ok;
  69
  70 #7
  71 if ($Is_VMS) {
  72     $a = `$^X "-I../lib" "-MO=Terse" -e "1"`;
  73 }
  74 else {
  75     $a = `$^X -I../lib -MO=Terse -e 1 2>&1`;
  76 }
  77 print "not " unless $a =~
  78 /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s;
  79 ok;
  80
  81 if ($Is_VMS) {
  82     $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/"`;
  83 }
  84 else {
  85     $a = `$^X -I../lib -MO=Terse -ane "s/foo/bar/" 2>&1`;
  86 }
  87 $a =~ s/\(0x[^)]+\)//g;
  88 $a =~ s/\[[^\]]+\]//g;
  89 $a =~ s/-e syntax OK//;
  90 $a =~ s/[^a-z ]+//g;
  91 $a =~ s/\s+/ /g;
  92 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
  93 $a =~ s/^\s+//;
  94 $a =~ s/\s+$//;
  95 $b=<<EOF;
  96 leave enter nextstate label leaveloop enterloop null and defined null
  97 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
  98 null gvsv const null pushmark rvav gv nextstate subst const unstack
  99 nextstate
 100 EOF
 101 $b=~s/\n/ /g;$b=~s/\s+/ /g;
 102 $b =~ s/\s+$//;
 103 print "# [$a] vs [$b]\nnot " if $a ne $b;
 104 ok;
 105
 106 if ($Is_VMS) {
 107     chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e "1"`);
 108 }
 109 else {
 110     chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`);
 111 }
 112 $a = join ',', sort split /,/, $a;
 113 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
 114 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
 115 if ($Config{static_ext} eq ' ') {
 116   $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
 117      . '-umain,-uwarnings';
 118   print "# [$a] vs [$b]\nnot " if $a ne $b;
 119   ok;
 120 } else {
 121   print "ok $test # skipped: one or more static extensions\n"; $test++;
 122 }
 123
 124 if ($Is_VMS) {
 125     $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one"`;
 126 }
 127 else {
 128     $a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`;
 129 }
 130 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
 131 ok;