summaryrefslogtreecommitdiffstats
path: root/perl_checker.src/test/test_it
blob: 2f7c599b6010b7451610de675fd20f09ddd68944 (plain)
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
99
100
101
102
#!/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 {
            # no comma for: 
            # - prefix for/foreach/...
            # - already a comma
            # - a block { ... }
            my $no_comma = $l[-1] =~ /(^\s*(for|foreach|if|unless|while|sub)\s)|(;\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;
}