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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
#!/usr/bin/perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
# This script checks that the compilers emit the errors which we expect.
# Usage: errchk COMPILER [OPTS] SOURCEFILES. This will run the command
# COMPILER [OPTS] SOURCEFILES. The compilation is expected to fail; if
# it succeeds, this script will report an error. The stderr output of
# the compiler will be matched against comments in SOURCEFILES. For each
# line of the source files which should generate an error, there should
# be a comment of the form // ERROR "regexp". If the compiler generates
# an error for a line which has no such comment, this script will report
# an error. Likewise if the compiler does not generate an error for a
# line which has a comment, or if the error message does not match the
# <regexp>. The <regexp> syntax is Perl but its best to stick to egrep.
use POSIX;
my $exitcode = 1;
if(@ARGV >= 1 && $ARGV[0] eq "-0") {
$exitcode = 0;
shift;
}
if(@ARGV < 1) {
print STDERR "Usage: errchk COMPILER [OPTS] SOURCEFILES\n";
exit 1;
}
# Grab SOURCEFILES
foreach(reverse 0 .. @ARGV-1) {
unless($ARGV[$_] =~ /\.(go|s)$/) {
@file = @ARGV[$_+1 .. @ARGV-1];
last;
}
}
# If no files have been specified try to grab SOURCEFILES from the last
# argument that is an existing directory if any
unless(@file) {
foreach(reverse 0 .. @ARGV-1) {
if(-d $ARGV[$_]) {
@file = glob($ARGV[$_] . "/*.go");
last;
}
}
}
foreach $file (@file) {
open(SRC, $file) || die "BUG: errchk: open $file: $!";
$src{$file} = [<SRC>];
close(SRC);
}
# Run command
$cmd = join(' ', @ARGV);
open(CMD, "exec $cmd </dev/null 2>&1 |") || die "BUG: errchk: run $cmd: $!";
# gc error messages continue onto additional lines with leading tabs.
# Split the output at the beginning of each line that doesn't begin with a tab.
$out = join('', <CMD>);
@out = split(/^(?!\t)/m, $out);
close CMD;
# Remove lines beginning with #, printed by go command to indicate package.
@out = grep {!/^#/} @out;
if($exitcode != 0 && $? == 0) {
print STDERR "BUG: errchk: command succeeded unexpectedly\n";
print STDERR @out;
exit 0;
}
if($exitcode == 0 && $? != 0) {
print STDERR "BUG: errchk: command failed unexpectedly\n";
print STDERR @out;
exit 0;
}
if(!WIFEXITED($?)) {
print STDERR "BUG: errchk: compiler crashed\n";
print STDERR @out, "\n";
exit 0;
}
sub bug() {
if(!$bug++) {
print STDERR "BUG: ";
}
}
sub chk {
my $file = shift;
my $line = 0;
my $regexp;
my @errmsg;
my @match;
foreach my $src (@{$src{$file}}) {
$line++;
next if $src =~ m|////|; # double comment disables ERROR
next unless $src =~ m|// (GC_)?ERROR (.*)|;
my $all = $2;
if($all !~ /^"([^"]*)"/) {
print STDERR "$file:$line: malformed regexp\n";
next;
}
@errmsg = grep { /$file:$line[:[]/ } @out;
@out = grep { !/$file:$line[:[]/ } @out;
if(@errmsg == 0) {
bug();
print STDERR "errchk: $file:$line: missing expected error: '$all'\n";
next;
}
foreach my $regexp ($all =~ /"([^"]*)"/g) {
# Turn relative line number in message into absolute line number.
if($regexp =~ /LINE(([+-])([0-9]+))?/) {
my $n = $line;
if(defined($1)) {
if($2 eq "+") {
$n += int($3);
} else {
$n -= int($3);
}
}
$regexp = "$`$file:$n$'";
}
@match = grep { /$regexp/ } @errmsg;
if(@match == 0) {
bug();
print STDERR "errchk: $file:$line: error messages do not match '$regexp'\n";
next;
}
@errmsg = grep { !/$regexp/ } @errmsg;
}
if(@errmsg != 0) {
bug();
print STDERR "errchk: $file:$line: unmatched error messages:\n";
foreach my $l (@errmsg) {
print STDERR "> $l";
}
}
}
}
foreach $file (@file) {
chk($file)
}
if(@out != 0) {
bug();
print STDERR "errchk: unmatched error messages:\n";
print STDERR "==================================================\n";
print STDERR @out;
print STDERR "==================================================\n";
}
exit 0;
|
