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