Commit | Line | Data |
82a7479c |
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| |
82a7479c |
65 | ../t/comp/require.t |
66 | |
82a7479c |
67 | ../t/comp/parser.t |
68 | |
82a7479c |
69 | ../t/op/switch.t |
70 | |
71 | ../t/op/attrhand.t |
72 | |
73 | ../t/op/symbolcache.t |
74 | |
b3f5cf18 |
75 | ../t/op/exec.t |
76 | ../t/io/say.t |
58a97135 |
77 | |
58a97135 |
78 | ../t/op/state.t |
58a97135 |
79 | ../t/op/tiehandle.t |
58a97135 |
80 | ../t/op/each_array.t |
58a97135 |
81 | ../t/lib/cygwin.t |
82a7479c |
82 | |; |
83 | |
84 | my @files; |
85 | find( sub { push @files, $File::Find::name if m/[.]t$/ }, '../t/'); |
86 | |
87 | for my $file (@files) { |
88 | my $input; |
89 | local $/ = undef; |
90 | local $TODO = (exists $failing{$file} ? "Known failure" : undef); |
91 | #warn $file; |
92 | open(my $fh, "<", "$file") or die "Failed open '../t/$file' $!"; |
93 | $input = $fh->getline; |
94 | close $fh or die; |
95 | |
96 | my $switches = ""; |
97 | if( $input =~ m/^[#][!].*perl(.*)/) { |
98 | $switches = $1; |
99 | } |
100 | |
101 | unlink "tmp.xml"; |
102 | `PERL_XMLDUMP='tmp.xml' ../perl $switches -I ../lib $file 2> tmp.err`; |
103 | |
104 | if (-z "tmp.xml") { |
105 | fail "MAD dump failure of '$file'"; |
106 | next; |
107 | } |
108 | my $output = eval { Nomad::xml_to_p5( input => "tmp.xml" ) }; |
109 | if ($@) { |
110 | fail "convert xml to p5 failed file: '$file'"; |
111 | diag "error: $@"; |
112 | next; |
113 | } |
114 | eq_or_diff $output, $input, "p55 '$file'"; |
115 | } |
116 | |
117 | __DATA__ |
118 | use strict; |
119 | #ABC |
120 | new Foo; |
121 | Foo->new; |
122 | ######## |
123 | sub pi() { 3.14 } |
124 | my $x = pi; |
125 | ######## |
126 | -OS_Code => $a |
127 | ######## |
128 | use encoding 'euc-jp'; |
129 | tr/¤¡-¤ó¥¡-¥ó/¥¡-¥ó¤¡-¤ó/; |
130 | ######## |
131 | sub ok($$) { } |
132 | BEGIN { ok(1, 2, ); } |
133 | ######## |
134 | for (my $i=0; $i<3; $i++) { } |
135 | ######## |
136 | for (; $a<3; $a++) { } |
137 | ######## |
b3f5cf18 |
138 | # |
82a7479c |
139 | s//$#foo/ge; |
140 | ######## |
b3f5cf18 |
141 | # |
82a7479c |
142 | s//m#.#/ge; |
143 | ######## |
b3f5cf18 |
144 | # |
82a7479c |
145 | eval { require 5.005 } |
146 | ######## |
c631f32b |
147 | # Reduced test case from t/io/layers.t |
82a7479c |
148 | sub PerlIO::F_UTF8 () { 0x00008000 } # from perliol.h |
149 | BEGIN { PerlIO::Layer->find("encoding",1);} |
150 | ######## |
27aaedc1 |
151 | # from ../t/op/array.t |
82a7479c |
152 | $[ = 1 |
153 | ######## |
27aaedc1 |
154 | # from t/comp/parser.t |
82a7479c |
155 | $x = 1 for ($[) = 0; |
156 | ######## |
d5d3e0f0 |
157 | # from t/op/getppid.t |
82a7479c |
158 | pipe my ($r, $w) |
159 | ######## |
160 | # TODO switch |
161 | use feature 'switch'; |
162 | given(my $x = "bar") { } |
163 | ######## |
164 | # TODO attribute t/op/attrhand.t |
165 | sub something : TypeCheck( |
166 | QNET::Util::Object, |
167 | QNET::Util::Object, |
168 | QNET::Util::Object |
169 | ) { # WrongAttr (perl tokenizer bug) |
170 | # keep this ^ lined up ! |
171 | return 42; |
172 | } |
173 | ######## |
174 | # TODO symbol table t/op/symbolcache.t |
175 | sub replaced2 { 'func' } |
176 | BEGIN { undef $main::{replaced2} } |
177 | ######## |
178 | # TODO exit in begin block. from t/op/threads.t without threads |
179 | BEGIN { |
180 | exit 0; |
181 | } |
182 | use foobar; |