#! /usr/bin/env perl

# (Tested with -w; 10/5/04)

# 

# Find the parse.sub routine.

my $maintdir = "./maint";

my $rootdir  = ".";

if ( ! -s "maint/parse.sub" ) {

    my $program = $0;

    $program =~ s/extracterrmsgs//;

    if (-s "$program/parse.sub") {

	$maintdir = $program;

	$rootdir  = $program;

	$rootdir  =~ s/\/maint//g;

	print "Rootdir = $rootdir\n" if $debug;

    }

}

require "$maintdir/parse.sub";

$debug = 0;

$careful = 0;        # Set careful to 1 to flag unused messages

$carefulFilename = "";

$showfiles = 0;

$quiet = 0;

$build_test_pgm = 1;

# FIXME: checkErrClass should be set to 1; currently set to zero

# to permit autogen.sh to complete

$checkErrClass = 1;

# Strict is used to control checking of error message strings.

$gStrict = 0;

if (defined($ENV{"DEBUG_STRICT"})) { $gStrict = 1; }

# Check for special args

@files = ();

%skipFiles = ();

my @errnameFiles = ();

$outfile = "";

foreach $arg (@ARGV) {

    if ($arg =~ /^--?showfiles/) { $showfiles = 1; }

    elsif( $arg =~ /^--?debug/) { $debug = 1; }

    elsif( $arg =~ /^--?quiet/) { $quiet = 1; }

    elsif( $arg =~ /^--?notest/) { $build_test_pgm = 0; }

    elsif( $arg =~ /^--?outfile=(.*)/) { $outfile = $1; }

    elsif( $arg =~ /^--?careful=(.*)/) {

	$careful = 1;

	$carefulFilename = $1;

    }

    elsif( $arg =~ /^--?careful/) { $careful = 1; }

    elsif( $arg =~ /^--?strict/)  { $gStrict = 1; }

    elsif( $arg =~ /^--?skip=(.*)/) { $skipFiles{$1} = 1; }

    else {

	print "Adding $arg to files\n" if $debug;

	if (-d $arg) {

	    # Add all .c files from directory $arg to the list of files 

	    # to process (this lets us shorten the arg list)

	    @files = (@files, &ExpandDir( $arg ));

	}

	else {

            # errname files are treated differently

            if ($arg =~ m{(^|[/\\])errnames.txt$}) {

                push @errnameFiles, $arg;

            }

            else {

                $files[$#files+1] = $arg;

            }

	}

    }

}

# End of argument processing

# Setup the basic file for errnames - Now determined in ExpandDirs

#@errnameFiles = ( "$rootdir/src/mpi/errhan/errnames.txt" );

if ($outfile ne "") {

    $OUTFD = "MyOutFile";

    open( $OUTFD, ">$outfile" ) or die "Could not open $outfile\n";

}

else {

    $OUTFD = STDOUT;

}

# Setup before processing the files

if ($build_test_pgm && -d "test/mpi/errhan") {

    # Get current directory incase we need it for the error message

    my $curdir = `pwd`;

    open( TESTFD, ">test/mpi/errhan/errcode.c" ) or die "Cannot create test program errcode.c in $curdir/test/mpi/errhan\n";

    print TESTFD "/* -*- Mode: C++; c-basic-offset:4 ; -*- */\

/*  \

 *  (C) 2004 by Argonne National Laboratory.\

 *      See COPYRIGHT in top-level directory.\

 *\

 * This file is automatically generated by maint/extracterrmsgs\

 * DO NOT EDIT\

 */\n";

    print TESTFD "#include <stdio.h>\n#include <stdlib.h>\n#include \"mpi.h\"\n";

    print TESTFD "#define MPIR_ERR_FATAL 1\n";

    print TESTFD "#define MPIR_ERR_RECOVERABLE 0\n";

    print TESTFD "int MPIR_Err_create_code( int, int, char *, int, int, const char [], const char [], ... );\n";

    print TESTFD "void ChkMsg( int, int, const char [] );\n\n";

    print TESTFD "int main(int argc, char **argv)\n";

    print TESTFD "{\n    int err;\n    MPI_Init( 0, 0 );\n";

}

# Process the definitions

foreach $file (@files) {

    print "$file\n" if $showfiles;

    &ProcessFile( $file );

}

#

# Create the hash %longnames that maps the short names to the long names,

# $longnames{shortname} => longname, by reading the errnames.txt files

foreach my $sourcefile (@errnameFiles) {

    #print STDERR "processing $sourcefile for error names\n";

    &ReadErrnamesFile( $sourcefile );

}

# Create the output files from the input that we've read

&CreateErrmsgsHeader( $OUTFD );

&CreateErrMsgMapping( $OUTFD );

if ($build_test_pgm && -d "test/mpi/errhan") {

    print TESTFD "    MPI_Finalize();\n    return 0;\n}\n";

    close TESTFD;

}    

#

# Generate a list of unused keys

if ($careful) {

    my $OUTFD = STDERR;

    if ($carefulFilename ne "") {

	$OUTFD = "ERRFD";

	open $OUTFD, ">$carefulFilename" or die "Cannot open $carefulFilename";

    }

    foreach $shortname (keys(%longnames)) {

	if (!defined($longnamesUsed{$shortname}) ||

	    $longnamesUsed{$shortname} < 1) {

	    $loc = $longnamesDefined{$shortname};

	    print $OUTFD "Name $shortname is defined in $loc but never used\n";

	}

    }

    if ($carefulFilename ne "") {

	close $OUTFD;

    }

}

#-----------------------------------------------------------------------------

# ROUTINES

# ----------------------------------------------------------------------------

# From the data collected above, generate the file containing the error message

# text.

# This is a temporary routine; the exact output form will be defined later

sub CreateErrmsgsHeader {

    $FD = $_[0];

    print $FD "/* -*- Mode: C; c-basic-offset:4 ; -*- */\

/*  \

 *  (C) 2001 by Argonne National Laboratory.\

 *      See COPYRIGHT in top-level directory.\

 *\

 * This file automatically created by extracterrmsgs\

 * DO NOT EDIT\

 */\n";

    print $FD "#if MPICH_ERROR_MSG_LEVEL > MPICH_ERROR_MSG__CLASS

typedef struct msgpair {

        const unsigned int sentinal1;

        const char *short_name, *long_name; 

        const unsigned int sentinal2; } msgpair;

#endif\n"

}

#

# We also need a way to create the records

# We then hash these on the first occurance (or precompute the hashes?)

#

# The error messages are output in the following form:

# typedef struct {const char short[], const long[]} namemap;

# Generic messages

# static const char[] short1 = "";

# static const char[] long1 = "";

# ...

# static const namemap[] = { {short1, long1}, {...} }

#

sub CreateErrMsgMapping {

    my $OUTFD = $_[0];

    # Create a mapping of MPI error classes to the specific error

    # message by index into generic_err_msgs.  This reads the file

    # baseerrnames, looks up the generic message, and maps the MPI error

    # class to the corresponding index.

    # We must do this here because we must ensure that all MPI error

    # classes have been added to the generic messages

    @class_msgs = ();

    open (FD, "<$rootdir/src/mpi/errhan/baseerrnames.txt" ) || 

	die "Could not open $rootdir/src/mpi/errhan/baseerrnames.txt\n";

    while (<FD>) {

	s/#.*$//;

	my ($mpiname,$num,$shortmsg) = split(/\s\s*/);

	if (!defined($shortmsg)) {

	    # Incase there is no short message entry (!)

	    $shortmsg = "";

	}

	if ($shortmsg ne "")

	{

	    if ($shortmsg =~ /\%/)

	    {

		print STDERR "Warning: generic message $shortmsg in baseerrnames.txt contains format control\n";

	    }

	    $generic_msgs{$shortmsg}++;

	    $generic_loc{$shortmsg} = ":baseerrnames.txt";

	    $class_msgs[$num] = "$shortmsg";

	}

    }

    close (FD);

    # For the case of classes only, output the strings for the class 

    # messages

    print $OUTFD "#if MPICH_ERROR_MSG_LEVEL == MPICH_ERROR_MSG__CLASS\n";

    print $OUTFD "#define MPIR_MAX_ERROR_CLASS_INDEX $#class_msgs+1\n";

    print $OUTFD "static const char *classToMsg[] = {\n";

    for (my $i=0; $i<=$#class_msgs; $i++) {

	my $shortname = $class_msgs[$i];

	my $msg       = $longnames{$shortname};

	print $OUTFD "\"$msg\", /* $i  $class_msgs[$i] */\n";

    }

    print $OUTFD "0 }; \n";

    print $OUTFD "#endif /* MSG_CLASS */\n";

    # Now, output each short,long key

    # Do the generic, followed by the specific, messages

    # The long messages must be available for the generic message output.

    # An alternative is to separate the short from the long messages;

    # the long messages are needed for > MSG_NONE, the short for > MSG_CLASS.

    print $OUTFD "#if MPICH_ERROR_MSG_LEVEL > MPICH_ERROR_MSG__CLASS\n";

    print $OUTFD "/* The names are in sorted order, allowing the use of a simple\

  linear search or bisection algorithm to find the message corresponding to\

  a particular message */\n";

    my $num = 0;

    foreach my $key (sort keys %generic_msgs)

    {

	$longvalue = "\"\0\"";

	if (!defined($longnames{$key}))

	{

	    $seenfile = $generic_loc{$key};

	    if ($key =~ /^\*\*/) {

		# If the message begins with text, assume that it is a 

		# litteral message

		print STDERR "Shortname $key for generic messages has no expansion (first seen in file $seenfile)\n";

		print STDERR "(Add expansion to $sourcefile)\n";

	    }

	    next;

	}

	else {

	    # Keep track of which messages we have seen

	    $longnamesUsed{$key} += 1;

	}

	# Escape any naked quotes (This should be applied somewhere else?)

#	$longvalue = s/(?

	$longvalue = "\"" . $longnames{$key} . "\"";

	print $OUTFD "static const char short_gen$num\[\] = \"$key\";\n";

#	print $OUTFD "static const char short_gen$num\[\] = $key;\n";

	print $OUTFD "static const char long_gen$num\[\]  = $longvalue;\n";

	# Remember the number assigned to this short string.

	$short_to_num{$key} = $num;

	$num ++;

    }

    # Generate the mapping of short to long names

    print $OUTFD "\nstatic const int generic_msgs_len = $num;\n";

    # The sentinals should be hardcoded into the source file that

    # uses this file to ensure that the sentinal tests are ok.

    my $sentinal1 = "0xacebad03";

    my $sentinal2 = "0xcb0bfa11";

    print $OUTFD "static const msgpair generic_err_msgs[] = {\n";

    for (my $i = 0; $i < $num; $i ++) {

	print $OUTFD "{ $sentinal1, short_gen$i, long_gen$i, $sentinal2 }";

	print $OUTFD "," if ($i < $num - 1);

	print $OUTFD "\n";

    }

    print $OUTFD "};\n";

    print $OUTFD "#endif\n\n";

    $num = 0;

    # Now output the instance specific messages

    print $OUTFD "#if MPICH_ERROR_MSG_LEVEL > MPICH_ERROR_MSG__GENERIC\n";

    foreach $key (sort keys %specific_msgs)

    {

	$longvalue = "\"\0\"";

	if (!defined($longnames{$key}))

	{

	    print STDERR "Shortname $key for specific messages has no expansion (first seen in file $specific_loc{$key})\n";

	    next;

	}

	else {

	    # Keep track of which messages we have seen

	    $longnamesUsed{$key} += 1;

	}

	# Escape any naked quotes

	$longvalue =~ s/(?

	$longvalue = "\"" . $longnames{$key} . "\"";

	print $OUTFD "static const char short_spc$num\[\] = \"$key\";\n";

#	print $OUTFD "static const char short_spc$num\[\] = $key;\n";

	print $OUTFD "static const char long_spc$num\[\]  = $longvalue;\n";

	$num ++;

    }

    # Generate the mapping of short to long names

    print $OUTFD "\nstatic const int specific_msgs_len = $num;\n";

    print $OUTFD "static const msgpair specific_err_msgs[] = {\n";

    for (my $i = 0; $i < $num ; $i ++) {

	print $OUTFD "{ $sentinal1, short_spc$i, long_spc$i, $sentinal2 }";

	print $OUTFD "," if ($i < $num - 1);

	print $OUTFD "\n";

    }

    print $OUTFD "};\n";

    print $OUTFD "#endif\n\n";

    print $OUTFD "#if MPICH_ERROR_MSG_LEVEL > MPICH_ERROR_MSG__CLASS\n";

    $maxval = $#class_msgs + 1;

    print $OUTFD "#define MPIR_MAX_ERROR_CLASS_INDEX $maxval\n";

    print $OUTFD "static int class_to_index[] = {\n";

    for (my $i=0; $i<=$#class_msgs; $i++) {

	print $OUTFD "$short_to_num{$class_msgs[$i]}";

	print $OUTFD "," if ($i < $#class_msgs);

	print $OUTFD "\n" if !(($i + 1) % 10);

    }

    print $OUTFD "};\n";

    print $OUTFD "#endif\n";

}

#

# Add a call to test this message for the error message.

# Handle both the generic and specific messages

#

sub AddTestCall {

    my $genericArgLoc = $_[0];

    my $last_errcode = "MPI_SUCCESS";  # $_[0];

    my $fatal_flag   = "MPIR_ERR_RECOVERABLE"; # $_[1];

    my $fcname       = "unknown"; # $_[2];

    my $linenum      = "__LINE__"; # $_[3];

    my $errclass     = "MPI_ERR_OTHER"; # $_[4];

    my $generic_msg = $_[$genericArgLoc+1];

    my $specific_msg = $_[$genericArgLoc+2];

    if ($#_ < $genericArgLoc+2) { $specific_msg = "0"; }

    # Ensure that the last_errcode, class and fatal flag are specified.  There are a few places where these are variables.

    if (!($last_errcode =~ /MPI_ERR_/) )

    {

	$last_errcode = "MPI_SUCCESS";

    }

    if (!($errclass =~ /MPI_ERR_/) )

    {

	$errclass = "MPI_ERR_OTHER";

    }

    if (!($fatal_flag =~ /MPIR_ERR_FATAL/) && !($fatal_flag =~ /MPIR_ERR_RECOVERABLE/))

    {

	$fatal_flag = "MPIR_ERR_FATAL";

    }

    # Generic message (first instance only)

    if (!defined($test_generic_msg{$generic_msg}))

    {

	$test_generic_msg{$generic_msg} = $filename;

	print TESTFD "    /* $filename */\n";

	print TESTFD "    err = MPIR_Err_create_code($last_errcode, $fatal_flag, \"errcode::main\", __LINE__, $errclass, ". 

	    "$generic_msg, 0);\n";

	print TESTFD "    ChkMsg( err, $errclass, $generic_msg );\n";

    }

    # Specific messages

    $specific_msg = "0" if ($specific_msg =~ /^\s*NULL\s*$/);

    if ($specific_msg ne "0" && !defined($test_specific_msg{$specific_msg}))

    {

	$test_specific_msg{$specific_msg} = $filename;

	print TESTFD "    {\n";

	print TESTFD "    /* $filename */\n";

	# Use types in the string to create the types with default

	# values

	my $format = $specific_msg;

	my $fullformat = $format;

	my $narg = 0;

	my @args = ();

	while ($format =~ /[^%]*%(.)(.*)/)

	{

	    my $type = $1; 

	    $format  = $2;

	    $narg ++;

	    if ($type eq "d")

	    {

		print TESTFD "    int i$narg = $narg;\n";

		$args[$#args+1] = "i$narg";

	    }

            elsif ($type eq "x")

            {

                print TESTFD "    int i$narg = $narg;\n";

                $args[$#args+1] = "i$narg";

            }

	    elsif ($type eq "L") 

	    {

		print TESTFD "    long long i$narg = $narg;\n";

		$args[$#args+1] = "i$narg";

	    }

            elsif ($type eq "X")

            {

                print TESTFD "    long long i$narg = $narg;\n";

                $args[$#args+1] = "i$narg";

            }

	    elsif ($type eq "i")

	    {

		print TESTFD "    int i$narg = $narg;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "t")

	    {

		print TESTFD "    int i$narg = $narg;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "s")

	    {

		print TESTFD "    char s$narg\[\] = \"string$narg\";\n";

		$args[$#args+1] = "s$narg";

	    }

	    elsif ($type eq "p")

	    {

		print TESTFD "    char s$narg\[\] = \"pointer$narg\";\n";

		$args[$#args+1] = "s$narg";

	    }

	    elsif ($type eq "C")

	    {

		print TESTFD "    int i$narg = MPI_COMM_WORLD;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "I")

	    {

		print TESTFD "    int i$narg = MPI_INFO_NULL;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "D")

	    {

		print TESTFD "    int i$narg = MPI_INT;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "F")

	    {

		# This must be an MPI_File since that type may not

		# be an integer (it is a pointer at this time)

		print TESTFD "    MPI_File i$narg = MPI_FILE_NULL;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "W")

	    {

		print TESTFD "    int i$narg = MPI_WIN_NULL;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "A")

	    {

		print TESTFD "    int i$narg = $narg;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "G")

	    {

		print TESTFD "    int i$narg = MPI_GROUP_NULL;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "O")

	    {

		print TESTFD "    int i$narg = MPI_SUM;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "R")

	    {

		print TESTFD "    int i$narg = MPI_REQUEST_NULL;\n";

		$args[$#args+1] = "i$narg";

	    }

	    elsif ($type eq "E")

	    {

		print TESTFD "    int i$narg = MPI_ERRORS_RETURN;\n";

		$args[$#args+1] = "i$narg";

	    }

            elsif ($type eq "c")

            {

                print TESTFD "    MPI_Count i$narg = $narg;\n";

                $args[$#args+1] = "i$narg";

            }

	    else

	    {

		print STDERR "Unrecognized format type $type for $fullformat in $filename\n";

	    }

	}   

	$actargs = $#_ - $genericArgLoc - 2;

	if ($actargs != $narg)

	{

	    print STDERR "Error: Format $fullformat provides $narg arguments but call has $actargs in $filename\n";

	}

	print TESTFD "     err = MPIR_Err_create_code($last_errcode, $fatal_flag, \"errcode::main\", __LINE__, $errclass, " .

	    "$generic_msg, $specific_msg";

	foreach my $arg (@args) 

	{

	    print TESTFD ", $arg";

	}

	print TESTFD " );\n";

	print TESTFD "    ChkMsg( err, $errclass, $specific_msg );\n    }\n";

	# ToDo: pass another string to ChkMsg that contains the 

	# names of the variables, as a single string (comma separated).

	# This allows us to review the source of the values for the args.

    }

}

# ==========================================================================

# Read an errnames file.  This allows us to distribute the errnames.txt

# files in the relevant modules, rather than making them part of one

# single master file.

# This updates the global hashs longnames and longnamesDefined

#  ReadErrnamesFile( filename )

# ==========================================================================

sub ReadErrnamesFile {

    my $sourcefile = $_[0];

    open( FD, "<$sourcefile" ) or return 0;

    my $linecount = 0;

    while (<FD>) {

	$linecount++;

	# Skip Comments

	if (/^\s*\#/) { next; }

	# Read entire error message (allow \ at end of line to continue)

	if (/^\s*(\*\*[^:]*):(.*)$/) {

	    my $name = $1;

	    my $repl = $2;

	    $repl =~ s/\r*\n*$//g;

	    while ($repl =~ /\\\s*$/) {

		# If there is a \\ at the end, read another.  

		# Remove the \ at the end (an alternative is to turn

		# it into a \n (newline), but we may want to avoid 

		# multiline messages

		$repl =~ s/\\\s*$//;

		my $inline = <FD>;

		$linecount++;

		$inline =~ s/^\s*//;   # remove leading spaces

		$repl .= $inline;

		$repl =~ s/[\r\n]*$//g; # remove newlines

	    }

	    # Check that the name and the replacement text at least

	    # partially match as to format specifiers

	    # (They should have exactly the same pattern, i.e., 

	    # if the name has %d %x in is, the replacement should 

	    # have %d %x, in that order)

	    my $namehasformat = ($name =~ /%/);

	    my $replhasformat = ($repl =~ /%/);

	    if ($namehasformat != $replhasformat) {

		print STDERR "Warning: format control usage in $name and $repl do not agree in $sourcefile\n";

	    }

#	    if (!defined($longnames{"\"$name\""}))

#	    {

#		$longnames{"\"$name\""} = $repl;

#		$longnamesDefined{"\"$name\""} = "$sourcefile:$linecount";

#	    }

	    # Check that the replacement text doesn't include a unquoted

	    # double quote

	    if ($repl =~ /(.)\"/) {

		my $prechar = $1;

		if ($1 ne "\\") {

		    print STDERR "Warning: Replacement text for $name contains an unescaped double quote: $repl\n";

		}

	    }

	    if (!defined($longnames{$name}))

	    {

		$longnames{$name} = $repl;

		$longnamesDefined{$name} = "$sourcefile:$linecount";

	    }

	    else

	    {

		print STDERR "Warning: attempt to redefine $name.  Duplicate ignored.\n";

		print STDERR "Previously defined at $longnamesDefined{$name} with value \"$longnames{$name}\"\n";

		print STDERR "Redefined at $sourcefile:$linecount with value \"$repl\"\n";

	    }

	}

    }

    close( FD );

}

# ==========================================================================

# Call this for each file

# This reads a C source or header file and adds does the following:

#   adds any generic message short names encountered to the hash generic_msgs.

#   adds any specific message short names encounter to the hash specific_msgs.

#   adds the filename to the hash generic_loc{msg} as the value (: separated)

#       and the same for hash specific_loc{msg}.

#   The last two are used to provide better error reporting.

#

$filename = "";    # Make global so that other routines can echo filename

sub ProcessFile

{ 

    # Leave filename global for AddTest

    $filename = $_[0];

    my $linecount = 0;

    open (FD, "<$filename" ) or die "Could not open $filename\n";

    while (<FD>) {

	$linecount++;

	# Skip code that is marked as ignore (e.g., for

	# macros that are used to simplify the use of MPIR_Err_create_code

	# (such macros must also be recognized and processed)

	if (/\/\*\s+--BEGIN ERROR MACROS--\s+\*\//) {

	    while (<FD>) {

		$linecount++;

		if (/\/\*\s+--END ERROR MACROS--\s+\*\//) { last; }

	    }

	    $remainder = "";

	    next;

	}

	# Next, remove any comments

	$_ = StripComments( FD, $_ );

	# Skip the definition of the function

	if (/int\s+MPI[OUR]_Err_create_code/) { $remainder = ""; next; }

	# Match the known routines and macros.

	# Then check that the arguments match if there is a 

	# specific string (number of args matches the number present)

        # MPIR_ERR_CHK(FATAL)?ANDJUMP[1-4]?(cond,code,class,gmsg[,smsg,args])

        # MPIR_ERR_SET(FATAL)?ANDJUMP[1-4]?(code,class,gmsg[,smsg,args])

	# MPIR_ERR_CHK(FATAL)?ANDSTMT[1-4]?(cond,code,class,stmt,gmsg[,smsg,args])

	# MPIR_ERR_SET(FATAL)?ANDSTMT[1-4]?(code,class,stmt,gmsg[,smsg,args])

	# Value is a tuple of:

	#  the count of args where the generic msg begins (starting from 0)

	#  location of __LINE__ (-1 for none)

	#  specific msg arg required (0 for no, > 0 for yes)

	#  is the generic message an indirect from errnames.txt (1=yes 0=no)

	#  location of the error class

	%KnownErrRoutines = ( 'MPIR_Err_create_code'      => '5:3:1:1:4', 

			      'MPIO_Err_create_code'      => '5:3:1:0:-1', 

			      'MPIR_ERR_SET'              => '2:-1:0:1:1',

			      'MPIR_ERR_SETSIMPLE'        => '2:-1:0:1:1',

			      'MPIR_ERR_SET1'             => '2:-1:1:1:1',

			      'MPIR_ERR_SET2'             => '2:-1:2:1:1',

			      'MPIR_ERR_SETANDSTMT'       => '3:-1:0:1:1',

			      'MPIR_ERR_SETANDSTMT1'      => '3:-1:1:1:1', 

			      'MPIR_ERR_SETANDSTMT2'      => '3:-1:1:1:1', 

			      'MPIR_ERR_SETANDSTMT3'      => '3:-1:1:1:1', 

			      'MPIR_ERR_SETANDSTMT4'      => '3:-1:1:1:1', 

			      'MPIR_ERR_SETANDJUMP'       => '2:-1:0:1:1',

			      'MPIR_ERR_SETANDJUMP1'      => '2:-1:1:1:1', 

			      'MPIR_ERR_SETANDJUMP2'      => '2:-1:1:1:1', 

			      'MPIR_ERR_SETANDJUMP3'      => '2:-1:1:1:1', 

			      'MPIR_ERR_SETANDJUMP4'      => '2:-1:1:1:1', 

			      'MPIR_ERR_CHKANDSTMT'       => '4:-1:0:1:2', 

			      'MPIR_ERR_CHKANDSTMT1'      => '4:-1:1:1:2', 

			      'MPIR_ERR_CHKANDSTMT2'      => '4:-1:1:1:2', 

			      'MPIR_ERR_CHKANDSTMT3'      => '4:-1:1:1:2', 

			      'MPIR_ERR_CHKANDSTMT4'      => '4:-1:1:1:2', 

			      'MPIR_ERR_CHKANDJUMP'       => '3:-1:0:1:2',

			      'MPIR_ERR_CHKANDJUMP1'      => '3:-1:1:1:2',

			      'MPIR_ERR_CHKANDJUMP2'      => '3:-1:1:1:2',

			      'MPIR_ERR_CHKANDJUMP3'      => '3:-1:1:1:2',

			      'MPIR_ERR_CHKANDJUMP4'      => '3:-1:1:1:2',

			      'MPIR_ERR_SETFATAL'         => '2:-1:0:1:1',

			      'MPIR_ERR_SETFATALSIMPLE'   => '2:-1:0:1:1',

			      'MPIR_ERR_SETFATAL1'        => '2:-1:1:1:1',

			      'MPIR_ERR_SETFATAL2'        => '2:-1:2:1:1',

			      'MPIR_ERR_SETFATALANDSTMT'  => '3:-1:0:1:1',

			      'MPIR_ERR_SETFATALANDSTMT1' => '3:-1:1:1:1', 

			      'MPIR_ERR_SETFATALANDSTMT2' => '3:-1:1:1:1', 

			      'MPIR_ERR_SETFATALANDSTMT3' => '3:-1:1:1:1', 

			      'MPIR_ERR_SETFATALANDSTMT4' => '3:-1:1:1:1', 

			      'MPIR_ERR_SETFATALANDJUMP'  => '2:-1:0:1:1',

			      'MPIR_ERR_SETFATALANDJUMP1' => '2:-1:1:1:1', 

			      'MPIR_ERR_SETFATALANDJUMP2' => '2:-1:1:1:1', 

			      'MPIR_ERR_SETFATALANDJUMP3' => '2:-1:1:1:1', 

			      'MPIR_ERR_SETFATALANDJUMP4' => '2:-1:1:1:1', 

			      'MPIR_ERR_CHKFATALANDSTMT'  => '4:-1:0:1:2', 

			      'MPIR_ERR_CHKFATALANDSTMT1' => '4:-1:1:1:2', 

			      'MPIR_ERR_CHKFATALANDSTMT2' => '4:-1:1:1:2', 

			      'MPIR_ERR_CHKFATALANDSTMT3' => '4:-1:1:1:2', 

			      'MPIR_ERR_CHKFATALANDSTMT4' => '4:-1:1:1:2', 

			      'MPIR_ERR_CHKFATALANDJUMP'  => '3:-1:0:1:2',

			      'MPIR_ERR_CHKFATALANDJUMP1' => '3:-1:1:1:2',

			      'MPIR_ERR_CHKFATALANDJUMP2' => '3:-1:1:1:2',

			      'MPIR_ERR_CHKFATALANDJUMP3' => '3:-1:1:1:2',

			      'MPIR_ERR_CHKFATALANDJUMP4' => '3:-1:1:1:2',

			      'MPIR_ERRTEST_VALID_HANDLE' => '4:-1:0:1:3',

			      );

	while (/(MPI[OUR]_E[A-Za-z0-9_]+)\s*(\(.*)$/) {

	    my $routineName = $1;

	    my $arglist     = $2;

	    if (!defined($KnownErrRoutines{$routineName})) {

		print "Skipping $routineName\n" if $debug;

		last;

	    }

	    print "Found $routineName\n" if $debug;

	    my ($genericArgLoc,$hasLine,$hasSpecific,$onlyIndirect,$errClassLoc) = 

		split(/:/,$KnownErrRoutines{$routineName});

	    ($leader, $remainder, @args ) = &GetSubArgs( FD, $arglist );

	    # Discard leader 

	    if ($debug) {

		print "Line begins with $leader\n";   # Use $leader to keep -w happy

		foreach $arg (@args) {

		    print "|$arg|\n";

		}

	    }

	    # Process the signature

	    # if signature does not match new function prototype, then skip it

	    if ($#args < $genericArgLoc) {

		if (!defined($bad_syntax_in_file{$filename})) {

		    $bad_syntax_in_file{$filename} = 1;

		    print STDERR "Warning: $routineName call with too few arguments in $filename\n";

		}

		next;

	    }

	    if ($hasLine >= 0 && 

		($args[$hasLine] ne "__LINE__" && $args[$hasLine] ne "line")) {

		if (!defined($bad_syntax_in_file{$filename})) {

		    $bad_syntax_in_file{$filename} = 1;

		    my $tmpi = $hasLine + 1;

		    print STDERR "Warning: Expected __LINE__ or line as ${tmpi}th argument of $routineName in $filename\n";

		}

		next;

	    }

	    if ($errClassLoc >= 0 && $checkErrClass) {

		if (!($args[$errClassLoc] =~ /^MPI_ERR_/)  &&

		    !($args[$errClassLoc] =~ /^MPI_T_ERR_/) &&

		    !($args[$errClassLoc] =~ /^MPIDI_CH3I_SOCK_ERR_/) &&

		    !($args[$errClassLoc] =~ /^MPIX_ERR_/) &&

		    !($args[$errClassLoc] =~ /^errclass/) &&

                    !($args[$errClassLoc] =~ /^\*\(errflag_\)/) &&

                    !($args[$errClassLoc] =~ /^\*errflag/)) {

		    $bad_syntax_in_file{$filename} = 1;

		    print STDERR "Invalid argument $args[$errClassLoc] for the MPI Error class in $routineName in $filename\n";

		    next;

		}

	    }

	    #my $last_errcode = $args[0];

	    #my $fatal_flag = $args[1];

	    #my $fcname = $args[2];

	    #my $linenum = $args[3];

	    #my $errclass = $args[4];

	    my $generic_msg = $args[$genericArgLoc];

	    my $specific_msg = "0";

	    if ($hasSpecific) {

		$specific_msg = $args[$genericArgLoc+1];

	    }

	    # Check the generic and specific message arguments

	    if ($generic_msg =~ /\s$/)

	    {

		print STDERR "Warning: trailing blank on arg $generic_msg in $filename!\n"; 

	    }

	    if ($onlyIndirect && !($generic_msg =~ /^\"\*\*\S+\"$/)) {

		print STDERR "Error: generic message $generic_msg has incorrect format in $filename\n";

		next;

	    }

	    if ($generic_msg =~ /%/) {

		print STDERR "Warning: generic message $generic_msg in $filename contains a format control\n";

	    }

	    $specific_msg = "0" if ($specific_msg =~ /^\s*NULL\s*$/);

	    if ($specific_msg =~ /^[1-9]/)

	    {

		print STDERR "Error: instance specific message $specific_msg in $filename is an invalid integer ". 

		    "(must be 0 or a string)\n";

		next;

	    }

	    if ($specific_msg eq $generic_msg)

	    {

		print STDERR "Warning: generic and instance specific messages must be different " .

		    "(file $filename, message $generic_msg)\n";

	    }

	    if ($specific_msg ne "0" && !($specific_msg =~ /\%/))

	    {

		print STDERR "Warning: instance specific message $specific_msg in $filename contains no format control\n";

	    }

	    if ($specific_msg =~ /%/) {

		# Specific message includes format values.  Check

		# for number and for valid strings if %s

		my $nargs = 0;

		my $tmpmsg = $specific_msg;

		my @stringLocs = ();

		while ($tmpmsg =~ /[^%]*%(.)(.*)/) {

		    $tmpmsg = $2;

		    my $followchar = $1;

		    if ($followchar eq "s") {

			$stringLocs[$#stringLocs+1] = $nargs;

		    }

		    if ($followchar ne "%") {

			$nargs ++;

		    }

                    if (! ($followchar =~ /[%sdxitpcDCRWOEIGFALX]/) ) {

			print STDERR "Warning: Unrecognized format specifier in specific message $specific_msg in $filename\n";

		    }

		}

		if ($nargs != $#args - $genericArgLoc - 1) {

		    my $actargs = $#args - $genericArgLoc - 1;

		    print STDERR "Warning: wrong number of arguments for instance specific message $specific_msg in $filename; expected $nargs but found $actargs\n";

		}

		elsif ($#stringLocs >= 0 && $gStrict) {

		    # Check for reasonable strings if strict checking requested

		    for (my $i=0; $i<=$#stringLocs; $i++) {

			my $index = $stringLocs[$i];

			my $string = $args[$genericArgLoc+2+$index];

			if ($string =~ /\"/) {

			    # Allow a few special cases:

			    # Always: all uppercase and _, single word

			    my $stringOk = 0;

			    if ($string =~ /^\"[A-Z_]*\"$/) {

				$stringOk = 1;

			    }

			    elsif ($string =~ /^\"\w*\"$/) {

				if (1) { $stringOk = 1; }

			    }

			    if (!$stringOk) {

				print STDERR "Warning: explicit string as argument to specific message $specific_msg in $filename; explicit string is $string\n";

			    }

			}

		    }

		}

	    }

	    if ($build_test_pgm) {

		&AddTestCall( $genericArgLoc, @args )

	    }

	    if ($generic_msg =~ /^\"(.*)\"$/) {

		$generic_msg = $1;

		$generic_msgs{$generic_msg}++;

		$generic_loc{$generic_msg} .= ":$filename";

	    }

	    else {

		$generic_msgs{$generic_msg}++;

		$generic_loc{$generic_msg} .= ":$filename";

	    }

	    if ($specific_msg =~ /^\"(\*\*.*)\"/)

	    {

		$specific_msg = $1;

		$specific_msgs{$specific_msg}++;

		$specific_loc{$specific_msg} .= ":$filename";

	    }

	}

	continue

        {

            $_ = $remainder;

        }

    }		

    close FD;

}

# Get all of the .c files from the named directory, including any subdirs

# Also, add any errnames.txt files to the errnamesFiles arrays

sub ExpandDir {

    my $dir = $_[0];

    my @otherdirs = ();

    my @files = ();

    opendir DIR, "$dir";

    while ($filename = readdir DIR) {

	if ($filename =~ /^\./) {

	    next;

	}

	elsif (-d "$dir/$filename") {

	    $otherdirs[$#otherdirs+1] = "$dir/$filename";

	}

	elsif ($filename =~ /(.*\.[chi])(pp){0,1}$/) {

	    # Test for both Unix- and Windows-style directory separators

	    if (!defined($skipFiles{"$dir/$filename"}) &&

		!defined($skipFiles{"$dir\\$filename"})) {

		$files[$#files + 1] = "$dir/$filename";

	    }

	}

	elsif ($filename eq "errnames.txt") {

	    $errnameFiles[$#errnameFiles+1] = "$dir/$filename";