t/lib/b.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @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 $a = `$^X "-I../lib" "-MO=Deparse" -anle 1 2>&1`;
  59 $a =~ s/-e syntax OK\n//g;
  60 $b = <<'EOF';
  61
  62 LINE: while (defined($_ = <ARGV>)) {
  63     chomp $_;
  64     @F = split(/\s+/, $_, 0);
  65     '???'
  66 }
  67 continue {
  68     '???'
  69 }
  70
  71 EOF
  72 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
  73 ok;
  74
  75 #6
  76 $a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
  77 print "not " unless $a =~
  78 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
  79 ok;
  80
  81 #7
  82 $a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
  83 print "not " unless $a =~
  84 /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s;
  85 ok;
  86
  87 $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/" 2>&1`;
  88 $a =~ s/\(0x[^)]+\)//g;
  89 $a =~ s/\[[^\]]+\]//g;
  90 $a =~ s/-e syntax OK//;
  91 $a =~ s/[^a-z ]+//g;
  92 $a =~ s/\s+/ /g;
  93 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
  94 $a =~ s/^\s+//;
  95 $a =~ s/\s+$//;
  96 my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
  97 if ($is_thread) {
  98     $b=<<EOF;
  99 leave enter nextstate label leaveloop enterloop null and defined null
 100 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
 101 threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
 102 EOF
 103 } else {
 104     $b=<<EOF;
 105 leave enter nextstate label leaveloop enterloop null and defined null
 106 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
 107 null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
 108 EOF
 109 }
 110 $b=~s/\n/ /g;$b=~s/\s+/ /g;
 111 $b =~ s/\s+$//;
 112 print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
 113 ok;
 114
 115 chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
 116 $a = join ',', sort split /,/, $a;
 117 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
 118 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
 119 $a =~ s/-uCwd,// if $^O eq 'cygwin';
 120 if ($Config{static_ext} eq ' ') {
 121   $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
 122      . '-umain,-uwarnings';
 123   print "# [$a] vs [$b]\nnot " if $a ne $b;
 124   ok;
 125 } else {
 126   print "ok $test # skipped: one or more static extensions\n"; $test++;
 127 }
 128
 129 if ($is_thread) {
 130     print "# use5005threads: test $test skipped\n";
 131 } else {
 132     $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
 133     print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
 134 }
 135 ok;