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..13\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 = <<'EOF';
  35 {
  36     $test = sub : lvalue {
  37         1;
  38     }
  39     ;
  40 }
  41 EOF
  42 chomp $a;
  43 print "not " if $deparse->coderef2text(sub{$test = sub : lvalue { 1 }}) ne $a;
  44 ok;
  45
  46 $a =~ s/lvalue/method/;
  47 print "not " if $deparse->coderef2text(sub{$test = sub : method { 1 }}) ne $a;
  48 ok;
  49
  50 $a =~ s/method/locked method/;
  51 print "not " if $deparse->coderef2text(sub{$test = sub : method locked { 1 }})
  52                                      ne $a;
  53 ok;
  54 }
  55
  56 my $a;
  57 my $Is_VMS = $^O eq 'VMS';
  58 if ($Is_VMS) {
  59     $^X = "MCR $^X";
  60     $a = `$^X "-I../lib" "-MO=Deparse" -anle "1"`;
  61 }
  62 else {
  63     $a = `$^X -I../lib -MO=Deparse -anle 1 2>&1`;
  64 }
  65 $a =~ s/-e syntax OK\n//g;
  66 $b = <<'EOF';
  67
  68 LINE: while (defined($_ = <ARGV>)) {
  69     chomp $_;
  70     @F = split(/\s+/, $_, 0);
  71     '???'
  72 }
  73 continue {
  74     '???'
  75 }
  76
  77 EOF
  78 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
  79 ok;
  80
  81 #6
  82 if ($Is_VMS) {
  83     $a = `$^X "-I../lib" "-MO=Debug" -e "1"`;
  84 }
  85 else {
  86     $a = `$^X -I../lib -MO=Debug -e 1 2>&1`;
  87 }
  88 print "not " unless $a =~
  89 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
  90 ok;
  91
  92 #7
  93 if ($Is_VMS) {
  94     $a = `$^X "-I../lib" "-MO=Terse" -e "1"`;
  95 }
  96 else {
  97     $a = `$^X -I../lib -MO=Terse -e 1 2>&1`;
  98 }
  99 print "not " unless $a =~
 100 /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s;
 101 ok;
 102
 103 if ($Is_VMS) {
 104     $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/"`;
 105 }
 106 else {
 107     $a = `$^X -I../lib -MO=Terse -ane "s/foo/bar/" 2>&1`;
 108 }
 109 $a =~ s/\(0x[^)]+\)//g;
 110 $a =~ s/\[[^\]]+\]//g;
 111 $a =~ s/-e syntax OK//;
 112 $a =~ s/[^a-z ]+//g;
 113 $a =~ s/\s+/ /g;
 114 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
 115 $a =~ s/^\s+//;
 116 $a =~ s/\s+$//;
 117 $b=<<EOF;
 118 leave enter nextstate label leaveloop enterloop null and defined null
 119 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
 120 null gvsv const null pushmark rvav gv nextstate subst const unstack
 121 nextstate
 122 EOF
 123 $b=~s/\n/ /g;$b=~s/\s+/ /g;
 124 $b =~ s/\s+$//;
 125 print "# [$a] vs [$b]\nnot " if $a ne $b;
 126 ok;
 127
 128 if ($Is_VMS) {
 129     chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e "1"`);
 130 }
 131 else {
 132     chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`);
 133 }
 134 $a = join ',', sort split /,/, $a;
 135 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
 136 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
 137 if ($Config{static_ext} eq ' ') {
 138   $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
 139      . '-umain,-uwarnings';
 140   print "# [$a] vs [$b]\nnot " if $a ne $b;
 141   ok;
 142 } else {
 143   print "ok $test # skipped: one or more static extensions\n"; $test++;
 144 }
 145
 146 if ($Is_VMS) {
 147     $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one"`;
 148 }
 149 else {
 150     $a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`;
 151 }
 152 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
 153 ok;