mirror of
https://github.com/HDFGroup/hdf5.git
synced 2026-09-25 04:09:44 +03:00
Larry Knox
2ea165efd0
* Modify temporary rpath for testing in java example scripts.
* Update URL in source file Copyright headers for web copy of COPYING
file - files not in src or test.
140 lines
4.5 KiB
Perl
Executable File
140 lines
4.5 KiB
Perl
Executable File
#!/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;
|
|
}
|
|
|
|
|