#!/usr/bin/env 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; } } 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; 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;