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 if($exitcode != 0 && $? == 0) {
     69 	print STDERR "BUG: errchk: command succeeded unexpectedly\n";
     70 	print STDERR @out;
     71 	exit 0;
     72 }
     73 
     74 if($exitcode == 0 && $? != 0) {
     75 	print STDERR "BUG: errchk: command failed unexpectedly\n";
     76 	print STDERR @out;
     77 	exit 0;
     78 }
     79 
     80 if(!WIFEXITED($?)) {
     81 	print STDERR "BUG: errchk: compiler crashed\n";
     82 	print STDERR @out, "\n";
     83 	exit 0;
     84 }
     85 
     86 sub bug() {
     87 	if(!$bug++) {
     88 		print STDERR "BUG: ";
     89 	}
     90 }
     91 
     92 sub chk {
     93 	my $file = shift;
     94 	my $line = 0;
     95 	my $regexp;
     96 	my @errmsg;
     97 	my @match;
     98 	foreach my $src (@{$src{$file}}) {
     99 		$line++;
    100 		next if $src =~ m|////|;  # double comment disables ERROR
    101 		next unless $src =~ m|// (GC_)?ERROR (.*)|;
    102 		my $all = $2;
    103 		if($all !~ /^"([^"]*)"/) {
    104 			print STDERR "$file:$line: malformed regexp\n";
    105 			next;
    106 		}
    107 		@errmsg = grep { /$file:$line[:[]/ } @out;
    108 		@out = grep { !/$file:$line[:[]/ } @out;
    109 		if(@errmsg == 0) {
    110 			bug();
    111 			print STDERR "errchk: $file:$line: missing expected error: '$all'\n";
    112 			next;
    113 		}
    114 		foreach my $regexp ($all =~ /"([^"]*)"/g) {
    115 			# Turn relative line number in message into absolute line number.
    116 			if($regexp =~ /LINE(([+-])([0-9]+))?/) {
    117 				my $n = $line;
    118 				if(defined($1)) {
    119 					if($2 eq "+") {
    120 						$n += int($3);
    121 					} else {
    122 						$n -= int($3);
    123 					}
    124 				}
    125 				$regexp = "$`$file:$n$'";
    126 			}
    127 	
    128 			@match = grep { /$regexp/ } @errmsg;
    129 			if(@match == 0) {
    130 				bug();
    131 				print STDERR "errchk: $file:$line: error messages do not match '$regexp'\n";
    132 				next;
    133 			}
    134 			@errmsg = grep { !/$regexp/ } @errmsg;
    135 		}
    136 		if(@errmsg != 0) {
    137 			bug();
    138 			print STDERR "errchk: $file:$line: unmatched error messages:\n";
    139 			foreach my $l (@errmsg) {
    140 				print STDERR "> $l";
    141 			}
    142 		}
    143 	}
    144 }
    145 
    146 foreach $file (@file) {
    147 	chk($file)
    148 }
    149 
    150 if(@out != 0) {
    151 	bug();
    152 	print STDERR "errchk: unmatched error messages:\n";
    153 	print STDERR "==================================================\n";
    154 	print STDERR @out;
    155 	print STDERR "==================================================\n";
    156 }
    157 
    158 exit 0;
    159