Home | History | Annotate | Download | only in test 
      1 #!/usr/bin/env perl
      2 # Copyright 2009 The Go Authors. All rights reserved.
      3 # Use of this source code is governed by a BSD-style
      4 # license that can be found in the LICENSE file.
      5 
      6 # This script checks that the compilers emit the errors which we expect.
      7 # Usage: errchk COMPILER [OPTS] SOURCEFILES.  This will run the command
      8 # COMPILER [OPTS] SOURCEFILES.  The compilation is expected to fail; if
      9 # it succeeds, this script will report an error.  The stderr output of
     10 # the compiler will be matched against comments in SOURCEFILES.  For each
     11 # line of the source files which should generate an error, there should
     12 # be a comment of the form // ERROR "regexp".  If the compiler generates
     13 # an error for a line which has no such comment, this script will report
     14 # an error.  Likewise if the compiler does not generate an error for a
     15 # line which has a comment, or if the error message does not match the
     16 # <regexp>.  The <regexp> syntax is Perl but its best to stick to egrep.
     17 
     18 use POSIX;
     19 
     20 my $exitcode = 1;
     21 
     22 if(@ARGV >= 1 && $ARGV[0] eq "-0") {
     23 	$exitcode = 0;
     24 	shift;
     25 }
     26 
     27 if(@ARGV < 1) {
     28 	print STDERR "Usage: errchk COMPILER [OPTS] SOURCEFILES\n";
     29 	exit 1;
     30 }
     31 
     32 # Grab SOURCEFILES
     33 foreach(reverse 0 .. @ARGV-1) {
     34 	unless($ARGV[$_] =~ /\.(go|s)$/) {
     35 		@file = @ARGV[$_+1 .. @ARGV-1];
     36 		last;
     37 	}
     38 }
     39 
     40 # If no files have been specified try to grab SOURCEFILES from the last
     41 # argument that is an existing directory if any
     42 unless(@file) {
     43     foreach(reverse 0 .. @ARGV-1) {
     44         if(-d $ARGV[$_]) {
     45             @file = glob($ARGV[$_] . "/*.go");
     46             last;
     47         }
     48     }
     49 }
     50 
     51 foreach $file (@file) {
     52 	open(SRC, $file) || die "BUG: errchk: open $file: $!";
     53 	$src{$file} = [<SRC>];
     54 	close(SRC);
     55 }
     56 
     57 # Run command
     58 $cmd = join(' ', @ARGV);
     59 open(CMD, "exec $cmd </dev/null 2>&1 |") || die "BUG: errchk: run $cmd: $!";
     60 
     61 # gc error messages continue onto additional lines with leading tabs.
     62 # Split the output at the beginning of each line that doesn't begin with a tab.
     63 $out = join('', <CMD>);
     64 @out = split(/^(?!\t)/m, $out);
     65 
     66 close CMD;
     67 
     68 # Remove lines beginning with #, printed by go command to indicate package.
     69 @out = grep {!/^#/} @out;
     70 
     71 if($exitcode != 0 && $? == 0) {
     72 	print STDERR "BUG: errchk: command succeeded unexpectedly\n";
     73 	print STDERR @out;
     74 	exit 0;
     75 }
     76 
     77 if($exitcode == 0 && $? != 0) {
     78 	print STDERR "BUG: errchk: command failed unexpectedly\n";
     79 	print STDERR @out;
     80 	exit 0;
     81 }
     82 
     83 if(!WIFEXITED($?)) {
     84 	print STDERR "BUG: errchk: compiler crashed\n";
     85 	print STDERR @out, "\n";
     86 	exit 0;
     87 }
     88 
     89 sub bug() {
     90 	if(!$bug++) {
     91 		print STDERR "BUG: ";
     92 	}
     93 }
     94 
     95 sub chk {
     96 	my $file = shift;
     97 	my $line = 0;
     98 	my $regexp;
     99 	my @errmsg;
    100 	my @match;
    101 	foreach my $src (@{$src{$file}}) {
    102 		$line++;
    103 		next if $src =~ m|////|;  # double comment disables ERROR
    104 		next unless $src =~ m|// (GC_)?ERROR (.*)|;
    105 		my $all = $2;
    106 		if($all !~ /^"([^"]*)"/) {
    107 			print STDERR "$file:$line: malformed regexp\n";
    108 			next;
    109 		}
    110 		@errmsg = grep { /$file:$line[:[]/ } @out;
    111 		@out = grep { !/$file:$line[:[]/ } @out;
    112 		if(@errmsg == 0) {
    113 			bug();
    114 			print STDERR "errchk: $file:$line: missing expected error: '$all'\n";
    115 			next;
    116 		}
    117 		foreach my $regexp ($all =~ /"([^"]*)"/g) {
    118 			# Turn relative line number in message into absolute line number.
    119 			if($regexp =~ /LINE(([+-])([0-9]+))?/) {
    120 				my $n = $line;
    121 				if(defined($1)) {
    122 					if($2 eq "+") {
    123 						$n += int($3);
    124 					} else {
    125 						$n -= int($3);
    126 					}
    127 				}
    128 				$regexp = "$`$file:$n$'";
    129 			}
    130 	
    131 			@match = grep { /$regexp/ } @errmsg;
    132 			if(@match == 0) {
    133 				bug();
    134 				print STDERR "errchk: $file:$line: error messages do not match '$regexp'\n";
    135 				next;
    136 			}
    137 			@errmsg = grep { !/$regexp/ } @errmsg;
    138 		}
    139 		if(@errmsg != 0) {
    140 			bug();
    141 			print STDERR "errchk: $file:$line: unmatched error messages:\n";
    142 			foreach my $l (@errmsg) {
    143 				print STDERR "> $l";
    144 			}
    145 		}
    146 	}
    147 }
    148 
    149 foreach $file (@file) {
    150 	chk($file)
    151 }
    152 
    153 if(@out != 0) {
    154 	bug();
    155 	print STDERR "errchk: unmatched error messages:\n";
    156 	print STDERR "==================================================\n";
    157 	print STDERR @out;
    158 	print STDERR "==================================================\n";
    159 }
    160 
    161 exit 0;
    162