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