mad/t/p55.t

   1
   2 # Test p55, the "Perl 5 to Perl 5" translator.
   3
   4 # The perl core should have MAD enabled ('sh Configure -Dmad=y ...')
   5
   6 # The part to convert xml to Perl 5 requires XML::Parser, but it does
   7 # not depend on Perl internals, so you can use a stable system wide
   8 # perl
   9
  10 # For the p55 on the perl test suite, it should be started from the
  11 # $perlsource/t subdir
  12
  13 # Instructions:
  14 #     sh Configure -Dmad=y
  15 #     make && make test
  16 #     cd t && /usr/bin/prove ../mad/t/p55.t
  17
  18 use strict;
  19 use warnings;
  20
  21 BEGIN {
  22     push @INC, "../mad";
  23 }
  24
  25 use Test::More qw|no_plan|;
  26 use IO::Handle;
  27
  28 use Nomad;
  29
  30 sub p55 {
  31     my ($input, $msg) = @_;
  32
  33     # perl5 to xml
  34     open my $infile, "> tmp.in";
  35     $infile->print($input);
  36     close $infile;
  37
  38     unlink "tmp.xml";
  39     `PERL_XMLDUMP='tmp.xml' ../perl -I ../lib tmp.in 2> tmp.err`;
  40
  41     if (-z "tmp.xml") {
  42         return ok 0, "MAD dump failed $msg";
  43     }
  44     my $output = eval { Nomad::xml_to_p5( input => "tmp.xml" ) };
  45     diag($@) if $@;
  46     is($output, $input, $msg);
  47 }
  48
  49 undef $/;
  50 my @prgs = split m/^########\n/m, <DATA>;
  51
  52 use bytes;
  53
  54 for my $prog (@prgs) {
  55     my $msg = ($prog =~ s/^#(.*)\n//) && $1;
  56     local $TODO = ($msg =~ /TODO/) ? 1 : 0;
  57     p55($prog, $msg);
  58 }
  59
  60 # Files
  61 use File::Find;
  62 use Test::Differences;
  63
  64 our %failing = map { $_, 1 } qw|
  65 ../t/op/subst.t
  66
  67 ../t/comp/require.t
  68
  69 ../t/io/layers.t
  70
  71 ../t/op/array.t
  72 ../t/op/local.t
  73 ../t/op/substr.t
  74
  75 ../t/comp/parser.t
  76
  77 ../t/op/getppid.t
  78
  79 ../t/op/switch.t
  80
  81 ../t/op/attrhand.t
  82
  83 ../t/op/symbolcache.t
  84
  85 ../t/op/threads.t
  86 |;
  87
  88 my @files;
  89 find( sub { push @files, $File::Find::name if m/[.]t$/ }, '../t/');
  90
  91 for my $file (@files) {
  92     my $input;
  93     local $/ = undef;
  94     local $TODO = (exists $failing{$file} ? "Known failure" : undef);
  95     #warn $file;
  96     open(my $fh, "<", "$file") or die "Failed open '../t/$file' $!";
  97     $input = $fh->getline;
  98     close $fh or die;
  99
 100     my $switches = "";
 101     if( $input =~ m/^[#][!].*perl(.*)/) {
 102         $switches = $1;
 103     }
 104
 105     unlink "tmp.xml";
 106     `PERL_XMLDUMP='tmp.xml' ../perl $switches -I ../lib $file 2> tmp.err`;
 107
 108     if (-z "tmp.xml") {
 109         fail "MAD dump failure of '$file'";
 110         next;
 111     }
 112     my $output = eval { Nomad::xml_to_p5( input => "tmp.xml" ) };
 113     if ($@) {
 114         fail "convert xml to p5 failed file: '$file'";
 115         diag "error: $@";
 116         next;
 117     }
 118     eq_or_diff $output, $input, "p55 '$file'";
 119 }
 120
 121 __DATA__
 122 use strict;
 123 #ABC
 124 new Foo;
 125 Foo->new;
 126 ########
 127 sub pi() { 3.14 }
 128 my $x = pi;
 129 ########
 130 -OS_Code => $a
 131 ########
 132 use encoding 'euc-jp';
 133 tr/¤¡-¤ó¥¡-¥ó/¥¡-¥ó¤¡-¤ó/;
 134 ########
 135 sub ok($$) { }
 136 BEGIN { ok(1, 2, ); }
 137 ########
 138 for (my $i=0; $i<3; $i++) { }
 139 ########
 140 for (; $a<3; $a++) { }
 141 ########
 142 # TODO
 143 s//$#foo/ge;
 144 ########
 145 # TODO
 146 s//m#.#/ge;
 147 ########
 148 # TODO
 149 eval { require 5.005 }
 150 ########
 151 # TODO Reduced test case from t/io/layers.t
 152 sub PerlIO::F_UTF8 () { 0x00008000 } # from perliol.h
 153 BEGIN { PerlIO::Layer->find("encoding",1);}
 154 ########
 155 # TODO from ../t/op/array.t
 156 $[ = 1
 157 ########
 158 # TODO from t/comp/parser.t
 159 $x = 1 for ($[) = 0;
 160 ########
 161 # TODO from t/op/getppid.t
 162 pipe my ($r, $w)
 163 ########
 164 # TODO switch
 165 use feature 'switch';
 166 given(my $x = "bar") { }
 167 ########
 168 # TODO attribute t/op/attrhand.t
 169 sub something : TypeCheck(
 170     QNET::Util::Object,
 171     QNET::Util::Object,
 172     QNET::Util::Object
 173 ) { #           WrongAttr (perl tokenizer bug)
 174     # keep this ^ lined up !
 175     return 42;
 176 }
 177 ########
 178 # TODO symbol table t/op/symbolcache.t
 179 sub replaced2 { 'func' }
 180 BEGIN { undef $main::{replaced2} }
 181 ########
 182 # TODO exit in begin block. from t/op/threads.t without threads
 183 BEGIN {
 184     exit 0;
 185 }
 186 use foobar;