1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
#!/usr/bin/perl
use lib '../..';
use MDK::Common;
use read_t;
my ($file) = @ARGV;
my @tests = read_t::read_t($file);
output('pkg3.pm', <<'EOF');
package pkg3;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
missing_fs => [ qw(f f0) ],
);
our @EXPORT_OK = qw(f);
EOF
my $header = <<'EOF';
package pkg;
use lib "../..";
sub new {}
sub m0 { my ($_o) = @_; 0 }
sub m1 { my ($_o, $a) = @_; $a }
sub m2 { my ($_o, $_a, $b) = @_; $b }
sub m0_or_2 { my ($_o, $_a, $b) = @_; $b }
package pkg2;
sub new {}
sub m0_or_2 { my ($_o) = @_; 0 }
package my_pkg;
sub nop {}
sub xxx { @_ }
sub yyy { @_ }
sub zzz { @_ }
sub pkg::nop {}
sub N { $_[0] }
sub N_ { $_[0] }
my ($xxx, $yyy, $zzz, $o, @l, @l2, %h);
xxx($xxx, $yyy, $zzz, $o, @l, @l2, %h);
use MDK::Common;
EOF
my $oo_header = <<'EOF';
EOF
my $local = <<'EOF';
{
local $_;
EOF
my $local_trailer = <<'EOF';
xxx($xxx, $yyy, $zzz, $o, @l, @l2, %h);
}
EOF
my $new;
foreach my $test (@tests) {
my @l = @{$test->{lines}};
pop @l while $l[-1] =~ /^\s*$/;
if (@l == 1) {
if ($l[-1] !~ /(;|[\s{]\})\s+$/) {
$l[-1] =~ s/^(.*?)(\s+$)/xxx($1);$2/;
} else {
my $no_comma = $l[-1] =~ /(^\s*(for|foreach|if|unless|while|sub)\s)|(;\s+$)/;
my $opt_comma = $no_comma ? '' : ';';
$l[-1] =~ s/(\s+$)/$opt_comma nop();$1/;
}
}
if (! any { /^(sub|use) / } @l) {
@l = ($local, @l, $local_trailer);
}
if (any { /->\w/ } @l) {
@l = ($oo_header, $header, @l);
} else {
@l = ($header, @l);
}
output('.pl', @l);
my @log = grep { !/^File .*, line / } `../perl_checker .pl`;
die "@log in .pl ($file):\n" . join('', @{$test->{lines}}) if any { /^syntax error$/ } @log;
foreach my $i (0 .. max(int @{$test->{lines}}, int @log) - 1) {
my $s = $test->{lines}[$i];
$s =~ s/\s+$//;
$new .= sprintf "%-40s %s", $s, $log[$i] || "\n";
}
$new .= "\n";
}
output("$file.new", $new);
if (system('diff', '-buB', $file, "$file.new") == 0) {
unlink "$file.new", '.pl', 'pkg3.pm';
exit 0;
} else {
warn "*" x 80, "\nnot same\n";
exit 1;
}
|
