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
-#!/usr/bin/perl
+package Nomad;
# Suboptimal things:
# ast type info is generally still implicit
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;
'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;
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;
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.)
--- /dev/null
+
+# 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;
projects / platform / upstream / perl.git / commitdiff