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

2 files changed, 229 insertions, 55 deletions

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, <DATA>;
+
+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;