# Test p55, the "Perl 5 to Perl 5" translator. # The perl core should have MAD enabled ('sh Configure -Dmad=y ...') # The part to convert xml to Perl 5 requires XML::Parser, but it does # not depend on Perl internals, so you can use a stable system wide # perl # For the p55 on the perl test suite, it should be started from the # $perlsource/t subdir # Instructions: # sh Configure -Dmad=y # make && make test # cd t && /usr/bin/prove ../mad/t/p55.t use strict; use warnings; BEGIN { push @INC, "../mad"; } use Test::More qw|no_plan|; use IO::Handle; use Nomad; sub p55 { my ($input, $msg) = @_; # perl5 to xml open my $infile, "> tmp.in"; $infile->print($input); close $infile; unlink "tmp.xml"; `PERL_XMLDUMP='tmp.xml' ../perl -I ../lib tmp.in 2> tmp.err`; if (-z "tmp.xml") { return ok 0, "MAD dump failed $msg"; } my $output = eval { Nomad::xml_to_p5( input => "tmp.xml" ) }; diag($@) if $@; is($output, $input, $msg); } undef $/; my @prgs = split m/^########\n/m, ; use bytes; for my $prog (@prgs) { my $msg = ($prog =~ s/^#(.*)\n//) && $1; local $TODO = ($msg =~ /TODO/) ? 1 : 0; p55($prog, $msg); } # Files use File::Find; use Test::Differences; our %failing = map { $_, 1 } qw| ../t/comp/require.t ../t/op/switch.t ../t/op/attrhand.t ../t/op/symbolcache.t ../t/op/exec.t ../t/op/state.t ../t/op/each_array.t ../t/lib/cygwin.t |; my @files; find( sub { push @files, $File::Find::name if m/[.]t$/ }, '../t/'); for my $file (@files) { my $input; local $/ = undef; local $TODO = (exists $failing{$file} ? "Known failure" : undef); #warn $file; open(my $fh, "<", "$file") or die "Failed open '../t/$file' $!"; $input = $fh->getline; close $fh or die; my $switches = ""; if( $input =~ m/^[#][!].*perl(.*)/) { $switches = $1; } unlink "tmp.xml"; `PERL_XMLDUMP='tmp.xml' ../perl $switches -I ../lib $file 2> tmp.err`; if (-z "tmp.xml") { fail "MAD dump failure of '$file'"; next; } my $output = eval { Nomad::xml_to_p5( input => "tmp.xml" ) }; if ($@) { fail "convert xml to p5 failed file: '$file'"; diag "error: $@"; next; } eq_or_diff $output, $input, "p55 '$file'"; } __DATA__ use strict; #ABC new Foo; Foo->new; ######## sub pi() { 3.14 } my $x = pi; ######## -OS_Code => $a ######## use encoding 'euc-jp'; tr/¤¡-¤ó¥¡-¥ó/¥¡-¥ó¤¡-¤ó/; ######## sub ok($$) { } BEGIN { ok(1, 2, ); } ######## for (my $i=0; $i<3; $i++) { } ######## for (; $a<3; $a++) { } ######## # s//$#foo/ge; ######## # s//m#.#/ge; ######## # eval { require 5.005 } ######## # Reduced test case from t/io/layers.t sub PerlIO::F_UTF8 () { 0x00008000 } # from perliol.h BEGIN { PerlIO::Layer->find("encoding",1);} ######## # from ../t/op/array.t $[ = 1 ######## # from t/comp/parser.t $x = 1 for ($[) = 0; ######## # from t/op/getppid.t pipe my ($r, $w) ######## # TODO switch use feature 'switch'; given(my $x = "bar") { } ######## # TODO attribute t/op/attrhand.t sub something : TypeCheck( QNET::Util::Object, QNET::Util::Object, QNET::Util::Object ) { # WrongAttr (perl tokenizer bug) # keep this ^ lined up ! return 42; } ######## # TODO symbol table t/op/symbolcache.t sub replaced2 { 'func' } BEGIN { undef $main::{replaced2} } ######## # TODO exit in begin block. from t/op/threads.t without threads BEGIN { exit 0; } use foobar;