#! /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";
}
}
closedir DIR;
# (almost) tail recurse on otherdirs (we've closed the directory handle,
# so we don't need to worry about it anymore)
foreach $dir (@otherdirs) {
@files = (@files, &ExpandDir( $dir ) );
}
return @files;
}
#
# Other todos:
# It would be good to keep track of any .N MPI_ERR_xxx names in the structured
# comment and match these against any MPI_ERR_yyy used in the code, emitting a
# warning message for MPI_ERR_yyy values used in the code but not mentioned
# in the header. This could even apply to routines that are not at the MPI
# layer, forcing all routines to document all MPI error classes that they might
# return (this is like requiring routines to document the exceptions that
# they may throw).