github.com/xushiwei/go@v0.0.0-20130601165731-2b9d83f45bc9/test/errchk (about)

     1  #!/usr/bin/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  foreach $file (@file) {
    41  	open(SRC, $file) || die "BUG: errchk: open $file: $!";
    42  	$src{$file} = [<SRC>];
    43  	close(SRC);
    44  }
    45  
    46  # Run command
    47  $cmd = join(' ', @ARGV);
    48  open(CMD, "exec $cmd </dev/null 2>&1 |") || die "BUG: errchk: run $cmd: $!";
    49  
    50  # 6g error messages continue onto additional lines with leading tabs.
    51  # Split the output at the beginning of each line that doesn't begin with a tab.
    52  $out = join('', <CMD>);
    53  @out = split(/^(?!\t)/m, $out);
    54  
    55  close CMD;
    56  
    57  if($exitcode != 0 && $? == 0) {
    58  	print STDERR "BUG: errchk: command succeeded unexpectedly\n";
    59  	print STDERR @out;
    60  	exit 0;
    61  }
    62  
    63  if($exitcode == 0 && $? != 0) {
    64  	print STDERR "BUG: errchk: command failed unexpectedly\n";
    65  	print STDERR @out;
    66  	exit 0;
    67  }
    68  
    69  if(!WIFEXITED($?)) {
    70  	print STDERR "BUG: errchk: compiler crashed\n";
    71  	print STDERR @out, "\n";
    72  	exit 0;
    73  }
    74  
    75  sub bug() {
    76  	if(!$bug++) {
    77  		print STDERR "BUG: ";
    78  	}
    79  }
    80  
    81  sub chk {
    82  	my $file = shift;
    83  	my $line = 0;
    84  	my $regexp;
    85  	my @errmsg;
    86  	my @match;
    87  	foreach my $src (@{$src{$file}}) {
    88  		$line++;
    89  		next if $src =~ m|////|;  # double comment disables ERROR
    90  		next unless $src =~ m|// (GC_)?ERROR (.*)|;
    91  		my $all = $2;
    92  		if($all !~ /^"([^"]*)"/) {
    93  			print STDERR "$file:$line: malformed regexp\n";
    94  			next;
    95  		}
    96  		@errmsg = grep { /$file:$line[:[]/ } @out;
    97  		@out = grep { !/$file:$line[:[]/ } @out;
    98  		if(@errmsg == 0) {
    99  			bug();
   100  			print STDERR "errchk: $file:$line: missing expected error: '$all'\n";
   101  			next;
   102  		}
   103  		foreach my $regexp ($all =~ /"([^"]*)"/g) {
   104  			# Turn relative line number in message into absolute line number.
   105  			if($regexp =~ /LINE(([+-])([0-9]+))?/) {
   106  				my $n = $line;
   107  				if(defined($1)) {
   108  					if($2 eq "+") {
   109  						$n += int($3);
   110  					} else {
   111  						$n -= int($3);
   112  					}
   113  				}
   114  				$regexp = "$`$file:$n$'";
   115  			}
   116  	
   117  			@match = grep { /$regexp/ } @errmsg;
   118  			if(@match == 0) {
   119  				bug();
   120  				print STDERR "errchk: $file:$line: error messages do not match '$regexp'\n";
   121  				next;
   122  			}
   123  			@errmsg = grep { !/$regexp/ } @errmsg;
   124  		}
   125  		if(@errmsg != 0) {
   126  			bug();
   127  			print STDERR "errchk: $file:$line: unmatched error messages:\n";
   128  			foreach my $l (@errmsg) {
   129  				print STDERR "> $l";
   130  			}
   131  		}
   132  	}
   133  }
   134  
   135  foreach $file (@file) {
   136  	chk($file)
   137  }
   138  
   139  if(@out != 0) {
   140  	bug();
   141  	print STDERR "errchk: unmatched error messages:\n";
   142  	print STDERR "==================================================\n";
   143  	print STDERR @out;
   144  	print STDERR "==================================================\n";
   145  }
   146  
   147  exit 0;