[svn-r60] ./bin/checkposix NEW

        Perl script that looks for Posix functions that haven't been
        protected by adding `HD' to the beginning of the name.  It
        takes a list of .c file names as arguments.

./bin/errors                    NEW
        A filter that takes a function prologue and function body as
        standard input and updates the error list in the prologue
        based on the function body.  You must add the `ERRORS' or
        `Errors:' field to the prologue before you pass it through
        this filter or else the errors come out as a separate
        comment.  The errors field must be terminated with a blank
        line in the prologue so we know where the end is.

        I may enhance this in the future to take an entire file as
        standard input instead of individual functions.

1 files changed, 127 insertions, 0 deletions

diff --git a/bin/errors b/bin/errors
new file mode 100755
index 0000000..28585cd
--- /dev/null
+++ b/bin/errors
@@ -0,0 +1,127 @@
+#!/usr/local/bin/perl -w
+require 5.003;
+use Text::Tabs;
+
+# Copyright (C) 1997 National Center for Supercomputing Applications.
+#		All rights reserved.
+#
+# Robb Matzke, matzke@llnl.gov
+# 30 Aug 1997
+#
+# Purpose: This script will read standard input which should be a
+#	   function prologue followed by a C function and will emit
+#	   on standard output the same source code with the function
+#	   prologue containing documentation for the various errors
+#	   that occur in the function.
+#
+#	   Errors are raised by calling HGOTO_ERROR() or
+#	   HRETURN_ERROR(). The reason for the error message is a
+#	   comment which appears immediately after the error macro
+#	   call and is contained entirely on one line:
+#
+#		HRETURN_ERROR (...); /*entry not found*/
+#
+#	   If such a comment doesn't exist, then the previous comment
+#	   is used, subject to the constraint that raising an error
+#	   clears the previous comment.
+#
+#	         /* Entry not found */
+#		 HGOTO_ERROR (...);
+#
+# 	   Emacs users can use this script interactively with the
+#	   c-mark-function and shell-command-on-region functions which
+#	   are normally bound to M-C-h and M-|.
+
+
+# Split STDIN into the prolog and the function body.  Preserve leading
+# white space.
+$_ = join "", <STDIN>;
+my ($head, $prolog, $body) = (/^(\s*)(\/\*(.*?)\*\/)?(.*)/s)[0,2,3];
+$prolog = "" unless $prolog;
+
+# Find each error and the comment that goes with it.
+for ($_=$body,$comment=""; /\/\*|H(RETURN|GOTO)_ERROR/s;) {
+   $_ = $&.$';
+
+   if (/^H(RETURN|GOTO)_ERROR\s*\(\s*H5E_(\w+)\s*,\s*H5E_(\w+)\s*,/s) {
+      ($major, $minor, $_) = ($2, $3, $');
+      $comment=$1 if /^.*?\)\s*;\s*\/\*\s*(.*?)\s*\*\//;
+      $comment =~ s/^\s*\*+\s*/ /mg; # leading asterisks.
+      $comment =~ s/^\s+//s;         # leading white space.
+      $comment =~ s/\s+$//s;         # trailing white space.
+      $comment =~ s/(\w)$/$1./s;     # punctuation.
+      $comment ||= "***NO COMMENT***";
+      $errors{"$major\000$minor\000\u$comment"} = 1;
+      $comment = "";
+
+   } else {
+      ($comment) = /^\/\*\s*(.*?)\s*\*\//s;
+      $_ = $';
+   }
+}
+
+
+# Format an error so it isn't too wide.
+sub fmt_error ($) {
+   local ($_) = @_;
+
+   my ($prefix,$space,$err) = /^((.*?)([A-Z_0-9]+\s+[A-Z_0-9]+\s+))/;
+   $_ = $';
+   tr/\n /  /s;
+   my $w = 70 - length expand $prefix;
+   s/(.{$w}\S+)\s+(\S)/$1."\n".$space.' 'x(length $err).$2/eg;
+   return $prefix . $_."\n";
+}
+
+
+
+# Sort the errors by major, then minor, then comment.  Duplicate
+# triplets have already been removed.
+sub by_triplet {
+   my ($a_maj, $a_min, $a_com) = split /\000/, $a;
+   my ($b_maj, $b_min, $b_com) = split /\000/, $b;
+   $a_maj cmp $b_maj || $a_min cmp $b_min || $a_com cmp $b_com;
+}
+@errors = map {sprintf "%-9s %-13s %s\n", split /\000/}
+          sort by_triplet keys %errors;
+
+
+
+# Add the list of errors to the prologue depending on the type of
+# prolog.
+if (($front, $back) = $prolog=~/^(.*?Errors:\s*?(?=\n)).*?\n\s*\*\s*\n(.*)/s) {
+   #| * Errors:							      |#
+   #| *		__list_of_error_messages__ (zero or more lines)	      |#
+   #| *								      |#
+   print $head, "/*", $front, "\n";
+   map {print fmt_error " *\t\t".$_} @errors;
+   print " *\n", $back, "*/", $body;
+
+} elsif (($front,$back) = $prolog =~
+	 /(.*?\n\s*ERRORS:?\s*?(?=\n)).*?\n\s*\n(.*)/s) {
+   #| ERRORS							      |#
+   #|		__list_of_error_messages__ (zero or more lines)	      |#
+   #|								      |#
+   print $head, "/*", $front, "\n";
+   map {print fmt_error "    ".$_} @errors;
+   print "\n", $back, "*/", $body;
+
+} elsif ($prolog eq "") {
+   # No prolog present.
+   print $head;
+   print "\n/*", "-"x73, "\n * Function:\t\n *\n * Purpose:\t\n *\n";
+   print " * Errors:\n";
+   map {print fmt_error " *\t\t".$_} @errors;
+   print " *\n * Return:\tSuccess:\t\n *\n *\t\tFailure:\t\n *\n";
+   print " * Programmer:\t\n *\n * Modifications:\n *\n *", '-'x73, "\n";
+   print " */\n", $body;
+
+} else {
+   # Prolog format not recognized.
+   print $head, "/*", $prolog, "*/\n\n";
+   print "/*\n * Errors returned by this function...\n";
+   map {print fmt_error " *\t".$_} @errors;
+   print " */\n", $body;
+}
+
+