From 82a7479cc5a6419185bb7d8b5f033dc6e60e261b Mon Sep 17 00:00:00 2001 From: Gerard Goossen Date: Mon, 26 Mar 2007 21:48:48 +0000 Subject: add p55.t MAD tests, and convert renamed mad/nomad into a module Subject: Re: [PATCH] p55 tests Message-ID: <20070322174056.GE24152@ostwald> p4raw-id: //depot/perl@30768 --- MANIFEST | 1 + mad/Nomad.pm | 98 ++++++++++++++----------------- mad/t/p55.t | 186 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 230 insertions(+), 55 deletions(-) create mode 100644 mad/t/p55.t diff --git a/MANIFEST b/MANIFEST index 897044b2a5..6964f8dd54 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2830,6 +2830,7 @@ mad/p55 Perl 5 to Perl 5 translator - driver for nomad mad/P5AST.pm Used by nomad mad/P5re.pm Used by nomad mad/PLXML.pm Used by nomad +mad/t/p55.t Test for the Perl 5 to Perl 5 translator makeaperl.SH perl script that produces a new perl binary makedef.pl Create symbol export lists for linking makedepend.SH Precursor to makedepend diff --git a/mad/Nomad.pm b/mad/Nomad.pm index c62ae6a9b4..1378e7b6e7 100755 --- a/mad/Nomad.pm +++ b/mad/Nomad.pm @@ -1,4 +1,4 @@ -#!/usr/bin/perl +package Nomad; # Suboptimal things: # ast type info is generally still implicit @@ -14,28 +14,47 @@ use Carp; use P5AST; use P5re; -my $dowarn = 0; -my $YAML = 0; my $deinterpolate; -while (@ARGV and $ARGV[0] =~ /^-./) { - my $switch = shift; - if ($switch eq '-w') { - $dowarn = 1; - } - elsif ($switch eq '-Y') { - $YAML = 1; - } - elsif ($switch eq '-d') { - $deinterpolate = 1; - } - else { - die "Unrecognized switch: -$switch"; +sub xml_to_p5 { + my %options = @_; + + + my $filename = $options{'input'} or die; + $deinterpolate = $options{'deinterpolate'}; + my $YAML = $options{'YAML'}; + + local $SIG{__DIE__} = sub { + my $e = shift; + $e =~ s/\n$/\n [NODE $filename line $::prevstate->{line}]/ if $::prevstate; + confess $e; + }; + + # parse file + use XML::Parser; + my $p1 = XML::Parser->new(Style => 'Objects', Pkg => 'PLXML'); + $p1->setHandlers('Char' => sub { warn "Chars $_[1]" if $_[1] =~ /\S/; }); + + # First slurp XML into tree of objects. + + my $root = $p1->parsefile($filename); + + # Now turn XML tree into something more like an AST. + + PLXML::prepreproc($root->[0]); + my $ast = P5AST->new('Kids' => [$root->[0]->ast()]); + #::t($ast); + + if ($YAML) { + require YAML::Syck; + return YAML::Syck::Dump($ast); } -} -@ARGV = ('foo.xml') unless @ARGV; -my $filename = shift; + # Finally, walk AST to produce new program. + + my $text = $ast->p5text(); # returns encoded, must output raw + return $text; +} $::curstate = 0; $::prevstate = 0; @@ -93,12 +112,6 @@ my %madtype = ( 'X' => 'p5::token', ); -$SIG{__DIE__} = sub { - my $e = shift; - $e =~ s/\n$/\n [NODE $filename line $::prevstate->{line}]/ if $::prevstate; - confess $e; -}; - use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Quotekeys = 0; @@ -339,31 +352,6 @@ sub encnum { use PLXML; -use XML::Parser; -my $p1 = new XML::Parser(Style => 'Objects', Pkg => 'PLXML'); -$p1->setHandlers('Char' => sub { warn "Chars $_[1]" if $_[1] =~ /\S/; }); - -# First slurp XML into tree of objects. - -my $root = $p1->parsefile($filename); - -# Now turn XML tree into something more like an AST. - -PLXML::prepreproc($root->[0]); -my $ast = P5AST->new('Kids' => [$root->[0]->ast()]); -#::t($ast); - -if ($YAML) { - require YAML::Syck; - print YAML::Syck::Dump($ast); - exit; -} - -# Finally, walk AST to produce new program. - -my $text = $ast->p5text(); # returns encoded, must output raw -print $text; - package p5::text; use Encode; @@ -967,22 +955,22 @@ BEGIN { my @args = $self->madness('A'); my $module = $module[-1]{Kids}[-1]; if ($module->uni eq 'bytes') { - $::curenc = ::encnum('iso-8859-1'); + $::curenc = Nomad::encnum('iso-8859-1'); } elsif ($module->uni eq 'utf8') { if ($$self{mp}{o} eq 'no') { - $::curenc = ::encnum('iso-8859-1'); + $::curenc = Nomad::encnum('iso-8859-1'); } else { - $::curenc = ::encnum('utf-8'); + $::curenc = Nomad::encnum('utf-8'); } } elsif ($module->uni eq 'encoding') { if ($$self{mp}{o} eq 'no') { - $::curenc = ::encnum('iso-8859-1'); + $::curenc = Nomad::encnum('iso-8859-1'); } else { - $::curenc = ::encnum(eval $args[0]->p5text); # XXX bletch + $::curenc = Nomad::encnum(eval $args[0]->p5text); # XXX bletch } } # (Surrounding {} ends up here if use is only thing in block.) diff --git a/mad/t/p55.t b/mad/t/p55.t new file mode 100644 index 0000000000..ef4c397e3b --- /dev/null +++ b/mad/t/p55.t @@ -0,0 +1,186 @@ + +# 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/op/subst.t + +../t/comp/require.t + +../t/io/layers.t + +../t/op/array.t +../t/op/local.t +../t/op/substr.t + +../t/comp/parser.t + +../t/op/getppid.t + +../t/op/switch.t + +../t/op/attrhand.t + +../t/op/symbolcache.t + +../t/op/threads.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++) { } +######## +# TODO +s//$#foo/ge; +######## +# TODO +s//m#.#/ge; +######## +# TODO +eval { require 5.005 } +######## +# TODO Reduced test case from t/io/layers.t +sub PerlIO::F_UTF8 () { 0x00008000 } # from perliol.h +BEGIN { PerlIO::Layer->find("encoding",1);} +######## +# TODO from ../t/op/array.t +$[ = 1 +######## +# TODO from t/comp/parser.t +$x = 1 for ($[) = 0; +######## +# TODO 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; -- cgit v1.2.1