diff options
-rwxr-xr-x | bin/errors | 139 |
1 files changed, 0 insertions, 139 deletions
diff --git a/bin/errors b/bin/errors deleted file mode 100755 index 5d23cf1..0000000 --- a/bin/errors +++ /dev/null @@ -1,139 +0,0 @@ -#!/usr/bin/env perl -require 5.003; -use warnings; -use Text::Tabs; - -# NOTE: THE FORMAT OF HRETURN_ERROR AND HGOTO_ERROR MACROS HAS -# CHANGED. THIS SCRIPT NO LONGER WORKS! --rpm - -# Copyright by The HDF Group. -# Copyright by the Board of Trustees of the University of Illinois. -# All rights reserved. -# -# This file is part of HDF5. The full HDF5 copyright notice, including -# terms governing use, modification, and redistribution, is contained in -# the COPYING file, which can be found at the root of the source code -# distribution tree, or in https://www.hdfgroup.org/licenses. -# If you do not have access to either file, you may request a copy from -# help@hdfgroup.org. -# -# Robb Matzke -# 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; -} - - |