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/-u(perlio|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
 130 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
 131 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
 132 $a =~ s/-uCwd,// if $^O eq 'cygwin';
 133 if ($Config{static_ext} eq ' ') {
 134   $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
 135      . '-umain,-uwarnings';
 136   print "# [$a] vs [$b]\nnot " if $a ne $b;
 137   ok;
 138 } else {
 139   print "ok $test # skipped: one or more static extensions\n"; $test++;
 140 }
 141
 142 if ($is_thread) {
 143     print "# use5005threads: test $test skipped\n";
 144 } else {
 145     $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
 146     print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
 147 }
 148 ok;