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 if ($Config{use5005threads} eq 'define') {
 118     $b=<<EOF;
 119 leave enter nextstate label leaveloop enterloop null and defined null
 120 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
 121 threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
 122 EOF
 123 } else {
 124     $b=<<EOF;
 125 leave enter nextstate label leaveloop enterloop null and defined null
 126 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
 127 null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
 128 EOF
 129 }
 130 $b=~s/\n/ /g;$b=~s/\s+/ /g;
 131 $b =~ s/\s+$//;
 132 print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
 133 ok;
 134
 135 if ($Is_VMS) {
 136     chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e "1"`);
 137 }
 138 else {
 139     chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`);
 140 }
 141 $a = join ',', sort split /,/, $a;
 142 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
 143 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
 144 if ($Config{static_ext} eq ' ') {
 145   $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
 146      . '-umain,-uwarnings';
 147   print "# [$a] vs [$b]\nnot " if $a ne $b;
 148   ok;
 149 } else {
 150   print "ok $test # skipped: one or more static extensions\n"; $test++;
 151 }
 152
 153 if ($Config{use5005threads} eq 'define') {
 154     print "# use5005threads: test $test skipped\n";
 155 } else {
 156     if ($Is_VMS) {
 157         $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one"`;
 158     }
 159     else {
 160         $a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`;
 161     }
 162     print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
 163 }
 164 ok;