diff options
Diffstat (limited to 'bin/errors')
| -rwxr-xr-x | bin/errors | 127 |
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; +} + + |