Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!utgpu!water!watnot!watmath!clyde!rutgers!husc6!seismo!nbires!hao!noao!mcdsun!fnf
From: fnf@mcdsun.UUCP
Newsgroups: net.sources
Subject: Portable Math Library in C (Part 5 of 6)
Message-ID: <293@mcdsun.UUCP>
Date: Fri, 10-Apr-87 18:46:05 EST
Article-I.D.: mcdsun.293
Posted: Fri Apr 10 18:46:05 1987
Date-Received: Sun, 12-Apr-87 20:37:48 EST
Organization: Motorola Microcomputer Division, Tempe, Az.
Lines: 2089
Keywords: math library

This is a portable math library written entirely in C.  Since it has been
several years since I had any interest in doing any more work on it, and
people may find it useful, I have decided to post it.  There should be
a lead-in posting (part 0 of 6?) containing a README file and commands
to make the directories for the regular parts 1-6.  Be sure to read the
README file in 'part 0'.

-Fred Fish

=============== Cut here and feed to the shell ========================


#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 5 (of 6)."
# Contents:  tests/c2d.c tests/d2d.c tests/dd2d.c tests/unused/d2i.c
#   tests/unused/di2d.c
# Wrapped by fnf@mcdsun on Fri Apr 10 16:21:47 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f tests/c2d.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"tests/c2d.c\"
else
echo shar: Extracting \"tests/c2d.c\" \(10177 characters\)
sed "s/^X//" >tests/c2d.c <<'END_OF_tests/c2d.c'
X/************************************************************************
X *									*
X *				N O T I C E				*
X *									*
X *			Copyright Abandoned, 1987, Fred Fish		*
X *									*
X *	This previously copyrighted work has been placed into the	*
X *	public domain by the author (Fred Fish) and may be freely used	*
X *	for any purpose, private or commercial.  I would appreciate	*
X *	it, as a courtesy, if this notice is left in all copies and	*
X *	derivative works.  Thank you, and enjoy...			*
X *									*
X *	The author makes no warranty of any kind with respect to this	*
X *	product and explicitly disclaims any implied warranties of	*
X *	merchantability or fitness for any particular purpose.		*
X *									*
X ************************************************************************
X */
X
X/*
X *  FILE
X *
X *	c2d.c   test complex to double math functions
X *
X *  KEY WORDS
X *
X *	portable math library
X *	test functions
X *
X *  DESCRIPTION
X *
X *	Tests double precision functions for the Portable Math
X *	Library.  Tests those functions which expect a single
X *	double precision complex argument and return a double.
X *
X *	Most of the test data in the current data file (c2d.dat)
X *	was generated using double precision FORTRAN arithmetic
X *	on a Decsystem-20.
X *
X *	Note that the ordering of functions is important for
X *	optimum error information.  Since some functions call
X *	others in the library, the functions being called should
X *	be tested first.  Naturally, an error in a lower level
X *	function will cause propagation of errors up to higher
X *	level functions.
X *
X *  USAGE
X *
X *	c2d [-esv] [-l limit]
X *
X *		-e	=>	force error for each test
X *				to verify error handling
X *
X *		-l	=>	report errors greater than
X *				specified limit (default 10**-6)
X *
X *		-s	=>	print summary after tests
X *
X *		-v	=>	print each function, argument,
X *				and result
X *
X *	Test directives are read from the standard input, which
X *	may be redirected to the provided test file (c2d.dat),
X *	and any relative errors are automatically written to standard
X *	output if they exceed a maximum allowable limit.
X *	Each test directive has the form:
X *
X *		<name> <real(arg)> <imag(arg)> <expected result>
X *
X *	Each field is separated by a one or more space character(s).
X *	The first field, "name", is the name of the function
X *	to test. The second field is the real part of the argument.
X *	The third field is the imaginary part of the argument.
X *	The last field is the expected result.
X *		
X *  PROGRAMMER
X *
X *	Fred Fish
X *	Tempe, Az 85281
X *
X */
X
X
X#include <stdio.h>
X#include <pmluser.h>
X
X#ifndef NODBG
X#include <dbg.h>
X#else
X#include "dbg.h"
X#endif
X
X#define TRUE 1			/* This really should be in stdio.h */
X#define FALSE 0			/* This too */
X#define MAX_ABS_ERR 1.0e-6	/* Set to catch only gross errors */
X
Xstatic int vflag;		/* Flag for verbose option */
Xstatic int eflag;		/* Simulate an error to error printout */
Xstatic int sflag;		/* Flag to show final statistics */
X
Xstatic double max_abs_err = MAX_ABS_ERR;
X
Xextern double cabs ();		/* Complex absolute value */
X
X
X/*
X *	Define all recognized test functions.  Each function
X *	must have an entry in this table, where each
X *	entry contains the information specified in the 
X *	structure "test".
X *
X */
X
Xstruct test {			/* Structure of each function to be tested */
X    char *name;			/* Name of the function to test */
X    double (*func)();		/* Pointer to the function's entry point */
X    double max_err;		/* Error accumulator for this function */
X};
X
Xstatic struct test tests[] = {	/* Table of all recognized functions */
X    "cabs", cabs, 0.0,		/* Complex magnitude */
X    NULL, NULL, 0.0		/* Function list end marker */
X};
X
X
X/*
X *  FUNCTION
X *
X *	main   entry point for c2d test utility
X *
X *  PSEUDO CODE
X *
X *	Begin main
X *	    Process any options in command line.
X *	    Do all tests requested by stdin directives.
X *	    Report final statistics (if enabled).
X *	End main
X *
X */
X
Xmain (argc, argv)
Xint argc;
Xchar *argv[];
X{
X    ENTER ("main");
X    DEBUGWHO (argv[0]);
X    options (argc, argv);
X    dotests (argv);
X    statistics ();
X    LEAVE ();
X}
X
X
X/*
X *  FUNCTION
X *
X *	dotests   process each test from stdin directives
X *
X *  ERROR REPORTING
X *
X *	Note that in most cases, the error criterion is based
X *	on relative error, defined as:
X *
X *	    error = (result - expected) / expected
X *
X *	Naturally, if the expected result is zero, some
X *	other criterion must be used.  In this case, the
X *	absolute error is used.  That is:
X *
X *	    error = result
X *
X *  PSEUDO CODE
X *
X *	Begin dotests
X *	    While a test directive is successfully read from stdin
X *		Default function name to "{null}"
X *		Default real part of argument to 0.0
X *		Default imaginary part of argument to 0.0
X *		Default expected result to 0.0
X *		Extract function name, argument and expected result
X *		Lookup test in available test list
X *		If no test was found then
X *		    Tell user that unknown function was specified
X *		Else
X *		    Call function with argument and save result
X *		    If the verify flag is set then
X *			Print function name, argument, and result
X *		    End if
X *		    If the expected result is not zero then
X *			Compute the relative error
X *		    Else
X *			Use the absolute error
X *		    End if
X *		    Get absolute value of error
X *		    If error exceeds limit or error force flag set
X *			Print error notification on stderr
X *		    End if
X *		    If this error is max for given function then
X *			Remember this error for summary
X *		    End if
X *		End if
X *	    End while
X *	End dotests
X *
X */
X
X
Xdotests (argv)
Xchar *argv[];
X{
X    char buffer[256];		/* Directive buffer */
X    char function[64];		/* Specified function name */
X    COMPLEX argument;		/* Specified function argument */
X    double expected;		/* Specified expected result */
X    double result;		/* Actual result */
X    double error;		/* Relative or absolute error */
X    double abs_err;		/* Absolute value of error */
X    struct test *testp;		/* Pointer to function test */
X    struct test *lookup ();	/* Returns function test pointer */
X    register char *strp;	/* Pointer to next token in string */
X    extern char *strtok ();
X    extern double atof ();
X
X    ENTER ("dotests");
X    while (fgets (buffer, sizeof(buffer), stdin) != NULL) {
X	strcpy (function, "{null}");
X	argument.real = 0.0;
X	argument.imag = 0.0;
X	expected = 0.0;
X	sscanf (buffer, "%s %le %le %le",
X	function, &argument.real, &argument.imag, &expected);
X        testp = lookup (function);
X        if (testp == NULL) {
X            fprintf (stderr, "%s: unknown function \"%s\".\n",
X	    	argv[0], function);
X        } else {
X	    result = (*testp -> func)(argument);
X	    if (vflag) {
X	        printf ("%s(%le + j %le) = %30.23le.\n",
X		function, argument.real, argument.imag, result);
X	    }
X	    if (expected != 0.0) {
X	        error = (result - expected) / expected;
X	    } else {
X	        error = result;
X	    }
X	    if (error < 0.0) {
X		abs_err = -error;
X	    } else {
X		abs_err = error;
X	    }
X            if ((abs_err > max_abs_err) || eflag) {
X		fprintf (stderr, "%s: error in \"%s\"\n", argv[0], function);
X		fprintf (stderr, "\treal (arg)\t%25.20le\n", argument.real);
X		fprintf (stderr, "\timag (arg)\t%25.20le\n", argument.imag);
X		fprintf (stderr, "\tresult\t\t%25.20le\n", result);
X		fprintf (stderr, "\texpected\t%25.20le\n", expected);
X            }
X	    if (abs_err > testp -> max_err) {
X	        testp -> max_err = abs_err;
X	    }
X        }
X    }
X    LEAVE ();
X}
X
X
X/*
X *  FUNCTION
X *
X *	options   process command line options
X *
X *  PSEUDO CODE
X *
X *	Begin options
X *	    Reset all flags to FALSE by default
X *	    Initialize flag argument scan pointer
X *	    If there is a second command line argument then
X *		If the argument specifies flags then
X *		    While there is an unprocessed flag
X *			Switch on flag
X *			Case "force error flag":
X *			    Set the "force error" flag
X *			    Break switch
X *			Case "print summary":
X *			    Set "print summary" flag
X *			    Break switch
X *			Case "verbose":
X *			    Set "verbose" flag
X *			    Break switch
X *			Default:
X *			    Tell user unknown flag
X *			    Break switch
X *			End switch
X *		    End while
X *		End if
X *	    End if
X *	End options
X *
X */
X
X
Xoptions (argc, argv)
Xint argc;
Xchar *argv[];
X{
X    register int flag;
X    extern int getopt ();
X    extern char *optarg;
X
X    ENTER ("options");
X    eflag = sflag = vflag = FALSE;
X    while ((flag = getopt (argc, argv, "#:el:sv")) != EOF) {
X	switch (flag) {
X	    case '#':
X	        DEBUGPUSH (optarg);
X		break;
X	    case 'e':
X		eflag = TRUE;
X		break;
X	    case 'l':
X	        sscanf (optarg, "%le", &max_abs_err);
X		DEBUG3 ("args", "max_abs_err = %le", max_abs_err);
X		break;
X	    case 's':
X		sflag = TRUE;
X		break;
X	    case 'v':
X		vflag = TRUE;
X		break;
X	}
X    }
X    LEAVE ();
X}
X
X
X/*
X *  FUNCTION
X *
X *	loopup   lookup test in known test list
X *
X *  DESCRIPTION
X *
X *	Given the name of a desired test, looks up the test
X *	in the known test list and returns a pointer to the
X *	test structure.
X *
X *	Since the table is so small we simply use a linear
X *	search.
X *
X *  PSEUDO CODE
X *
X *	Begin lookup
X *	    For each known test
X *		If the test's name matches the desired test name
X *		    Return pointer to the test structure
X *		End if
X *	    End for
X *	End lookup
X *
X */
X
Xstruct test *lookup (funcname)
Xchar *funcname;
X{
X    struct test *testp;
X    struct test *rtnval;
X
X    ENTER ("lookup");
X    rtnval = (struct test *) NULL;
X    for (testp = tests; testp -> name != NULL && rtnval == NULL; testp++) {
X	if (!strcmp (testp -> name, funcname)) {
X	    rtnval = testp;
X 	}
X    }
X    LEAVE ();
X    return (rtnval);
X}
X
X
X/*
X *  FUNCTION
X *
X *	statistics   print final statistics if desired
X *
X *  PSEUDO CODE
X *
X *	Begin statistics
X *	    If a final statistics (summary) is desired then
X *		For each test in the known test list
X *		    Print the maximum error encountered
X *		End for
X *	    End if
X *	End statistics
X *
X */
X
Xstatistics ()
X{
X    struct test *tp;
X
X    ENTER ("statistics");
X    if (sflag) {
X        for (tp = tests; tp -> name != NULL; tp++) {
X	    printf ("%s:\tmaximum relative error %le\n", 
X	    	tp -> name, tp -> max_err);
X	}
X    }
X    LEAVE ();
X}
END_OF_tests/c2d.c
if test 10177 -ne `wc -c <tests/c2d.c`; then
    echo shar: \"tests/c2d.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tests/d2d.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"tests/d2d.c\"
else
echo shar: Extracting \"tests/d2d.c\" \(11104 characters\)
sed "s/^X//" >tests/d2d.c <<'END_OF_tests/d2d.c'
X/************************************************************************
X *									*
X *				N O T I C E				*
X *									*
X *			Copyright Abandoned, 1987, Fred Fish		*
X *									*
X *	This previously copyrighted work has been placed into the	*
X *	public domain by the author (Fred Fish) and may be freely used	*
X *	for any purpose, private or commercial.  I would appreciate	*
X *	it, as a courtesy, if this notice is left in all copies and	*
X *	derivative works.  Thank you, and enjoy...			*
X *									*
X *	The author makes no warranty of any kind with respect to this	*
X *	product and explicitly disclaims any implied warranties of	*
X *	merchantability or fitness for any particular purpose.		*
X *									*
X ************************************************************************
X */
X
X
X/*
X *  FILE
X *
X *	d2d.c   test double to double math functions
X *
X *  KEY WORDS
X *
X *	portable math library
X *	test functions
X *
X *  DESCRIPTION
X *
X *	Tests double precision functions for the Portable Math
X *	Library.  Tests those functions which expect a single
X *	double precision argument and return a double.
X *
X *	Most of the test data in the current data file (d2d.dat)
X *	was generated using double precision FORTRAN arithmetic
X *	on a Decsystem-20.
X *
X *	Note that the ordering of functions is important for
X *	optimum error information.  Since some functions call
X *	others in the library, the functions being called should
X *	be tested first.  Naturally, an error in a lower level
X *	function will cause propagation of errors up to higher
X *	level functions.
X *
X *  USAGE
X *
X *	d2d [-esv] [-l limit]
X *
X *		-e	=>	force error for each test
X *				to verify error handling
X *
X *		-l	=>	report errors greater than
X *				specified limit (default 10**-6)
X *
X *		-s	=>	print summary after tests
X *
X *		-v	=>	print each function, argument,
X *				and result
X *
X *	Test directives are read from the standard input, which
X *	may be redirected to the provided test file (d2d.dat),
X *	and any relative errors are automatically written to standard
X *	output if they exceed a maximum allowable limit.
X *	Each test directive has the form:
X *
X *		<name> <argument> <expected result>
X *
X *	Each field is separated by a one or more space character(s).
X *	The first field, "name", is the name of the function
X *	to test (sqrt, ln, exp, etc).  The second field
X *	is the argument to use in calling the specified function.
X *	The third field is the expected result.
X *		
X *  PROGRAMMER
X *
X *	Fred Fish
X *
X */
X
X
X#include <stdio.h>
X#include "pml.h"
X
X#define MAX_ABS_ERR 1.0e-6	/* Set to catch only gross errors */
X
Xstatic int vflag;		/* Flag for verbose option */
Xstatic int eflag;		/* Simulate an error to error printout */
Xstatic int sflag;		/* Flag to show final statistics */
X
Xstatic double max_abs_err = MAX_ABS_ERR;
X
Xextern double dabs ();
Xextern double acos ();
Xextern double acosh ();
Xextern double asin ();
Xextern double asinh ();
Xextern double atan ();
Xextern double atanh ();
Xextern double cos ();
Xextern double cosh ();
Xextern double exp ();
Xextern double log ();
Xextern double log10 ();
Xextern double sin ();
Xextern double sinh ();
Xextern double sqrt ();
Xextern double tan ();
Xextern double tanh ();
X
X
X
X/*
X *	Define all recognized test functions.  Each function
X *	must have an entry in this table, where each
X *	entry contains the information specified in the 
X *	structure "test".
X *
X */
X
Xstruct test {			/* Structure of each function to be tested */
X    char *name;			/* Name of the function to test */
X    double (*func)();		/* Pointer to the function's entry point */
X    double max_err;		/* Error accumulator for this function */
X};
X
Xstatic struct test tests[] = {	/* Table of all recognized functions */
X    "dabs", dabs, 0.0,		/* Absolute value */
X    "acos", acos, 0.0,		/* Arc cosine (in radians) */
X    "acosh", acosh, 0.0,	/* Hyperbolic arc cosine (in radians) */
X    "asin", asin, 0.0,		/* Arc sine (in radians) */
X    "asinh", asinh, 0.0,	/* Hyperbolic arc sine (in radians) */
X    "atan", atan, 0.0,		/* Arc tangent (in radians) */
X    "atanh", atanh, 0.0,	/* Hyperbolic arc tangent (in radians) */
X    "cos", cos, 0.0,		/* Cosine (argument in radians) */
X    "cosh", cosh, 0.0,		/* Hyperbolic cosine (argument in radians) */
X    "exp", exp, 0.0,		/* Exponential */
X    "log", log, 0.0,		/* Natural logarithm */
X    "log10", log10, 0.0,	/* Log to base 10 */
X    "sin", sin, 0.0,		/* Sine (argument in radians) */
X    "sinh", sinh, 0.0,		/* Hyperbolic sine (argument in radians) */
X    "sqrt", sqrt, 0.0,		/* Garden variety square root */
X    "tan", tan, 0.0,		/* Tangent (argument in radians) */
X    "tanh", tanh, 0.0,		/* Hyperbolic tangent (argument in radians) */
X    NULL, NULL, 0.0		/* Function list end marker */
X};
X
X
X/*
X *  FUNCTION
X *
X *	main   entry point for d2d test utility
X *
X *  PSEUDO CODE
X *
X *	Begin main
X *	    Process any options in command line.
X *	    Do all tests requested by stdin directives.
X *	    Report final statistics (if enabled).
X *	End main
X *
X */
X
Xmain (argc, argv)
Xint argc;
Xchar *argv[];
X{
X    VOID dotests ();
X    
X    DBUG_ENTER ("main");
X    DBUG_PROCESS (argv[0]);
X    options (argc, argv);
X    dotests (argv);
X    statistics ();
X    DBUG_RETURN (0);
X}
X
X
X/*
X *  FUNCTION
X *
X *	dotests   process each test from stdin directives
X *
X *  ERROR REPORTING
X *
X *	Note that in most cases, the error criterion is based
X *	on relative error, defined as:
X *
X *	    error = (result - expected) / expected
X *
X *	Naturally, if the expected result is zero, some
X *	other criterion must be used.  In this case, the
X *	absolute error is used.  That is:
X *
X *	    error = result
X *
X *  PSEUDO CODE
X *
X *	Begin dotests
X *	    While a test directive is successfully read from stdin
X *		Default function name to "{null}"
X *		Default argument to 0.0
X *		Default expected result to 0.0
X *		Extract function name, argument and expected result
X *		Lookup test in available test list
X *		If no test was found then
X *		    Tell user that unknown function was specified
X *		Else
X *		    Call function with argument and save result
X *		    If the verify flag is set then
X *			Print function name, argument, and result
X *		    End if
X *		    If the expected result is not zero then
X *			Compute the relative error
X *		    Else
X *			Use the absolute error
X *		    End if
X *		    Get absolute value of error
X *		    If error exceeds limit or error force flag set
X *			Print error notification on stderr
X *		    End if
X *		    If this error is max for given function then
X *			Remember this error for summary
X *		    End if
X *		End if
X *	    End while
X *	End dotests
X *
X */
X
X
XVOID dotests (argv)
Xchar *argv[];
X{
X    char buffer[256];		/* Directive buffer */
X    char function[64];		/* Specified function name */
X    double argument;		/* Specified function argument */
X    double expected;		/* Specified expected result */
X    double result;		/* Actual result */
X    double error;		/* Relative or absolute error */
X    double abs_err;		/* Absolute value of error */
X    struct test *testp;		/* Pointer to function test */
X    struct test *lookup ();	/* Returns function test pointer */
X    register char *strp;	/* Pointer to next token in string */
X    extern char *strtok ();
X    extern double atof ();
X
X    DBUG_ENTER ("dotests");
X    while (fgets (buffer, sizeof(buffer), stdin) != NULL) {
X	strcpy (function, "{null}");
X	argument = 0.0;
X	expected = 0.0;
X	sscanf (buffer, "%s %le %le", function, &argument, &expected);
X        testp = lookup (function);
X        if (testp == NULL) {
X            fprintf (stderr, "%s: unknown function \"%s\".\n",
X	    	argv[0], function);
X        } else {
X	    result = (*testp -> func)(argument);
X	    if (vflag) {
X	        printf ("%s(%le) = %30.23le.\n", function, argument, result);
X	    }
X	    if (expected != 0.0) {
X	        error = (result - expected) / expected;
X	    } else {
X	        error = result;
X	    }
X	    if (error < 0.0) {
X		abs_err = -error;
X	    } else {
X		abs_err = error;
X	    }
X            if ((abs_err > max_abs_err) || eflag) {
X		fprintf (stderr, "%s: error in \"%s\"\n", argv[0], function);
X		fprintf (stderr, "\targument\t%25.20le\n", argument);
X		fprintf (stderr, "\tresult\t\t%25.20le\n", result);
X		fprintf (stderr, "\texpected\t%25.20le\n", expected);
X            }
X	    if (abs_err > testp -> max_err) {
X	        testp -> max_err = abs_err;
X	    }
X        }
X    }
X    DBUG_VOID_RETURN;
X}
X
X
X/*
X *  FUNCTION
X *
X *	options   process command line options
X *
X *  PSEUDO CODE
X *
X *	Begin options
X *	    Reset all flags to FALSE by default
X *	    Initialize flag argument scan pointer
X *	    If there is a second command line argument then
X *		If the argument specifies flags then
X *		    While there is an unprocessed flag
X *			Switch on flag
X *			Case "force error flag":
X *			    Set the "force error" flag
X *			    Break switch
X *			Case "print summary":
X *			    Set "print summary" flag
X *			    Break switch
X *			Case "verbose":
X *			    Set "verbose" flag
X *			    Break switch
X *			Default:
X *			    Tell user unknown flag
X *			    Break switch
X *			End switch
X *		    End while
X *		End if
X *	    End if
X *	End options
X *
X */
X
X
Xoptions (argc, argv)
Xint argc;
Xchar *argv[];
X{
X    register int flag;
X    extern int getopt ();
X    extern char *optarg;
X
X    DBUG_ENTER ("options");
X    eflag = sflag = vflag = FALSE;
X    while ((flag = getopt (argc, argv, "#:el:sv")) != EOF) {
X	switch (flag) {
X	    case '#':
X	        DBUG_PUSH (optarg);
X		break;
X	    case 'e':
X		eflag = TRUE;
X		break;
X	    case 'l':
X	        sscanf (optarg, "%le", &max_abs_err);
X		DBUG_3 ("args", "max_abs_err = %le", max_abs_err);
X		break;
X	    case 's':
X		sflag = TRUE;
X		break;
X	    case 'v':
X		vflag = TRUE;
X		break;
X	}
X    }
X    DBUG_VOID_RETURN;
X}
X
X
X/*
X *  FUNCTION
X *
X *	loopup   lookup test in known test list
X *
X *  DESCRIPTION
X *
X *	Given the name of a desired test, looks up the test
X *	in the known test list and returns a pointer to the
X *	test structure.
X *
X *	Since the table is so small we simply use a linear
X *	search.
X *
X *  PSEUDO CODE
X *
X *	Begin lookup
X *	    For each known test
X *		If the test's name matches the desired test name
X *		    Return pointer to the test structure
X *		End if
X *	    End for
X *	End lookup
X *
X */
X
Xstruct test *lookup (funcname)
Xchar *funcname;
X{
X    struct test *testp;
X    struct test *rtnval;
X
X    DBUG_ENTER ("lookup");
X    rtnval = (struct test *) NULL;
X    for (testp = tests; testp -> name != NULL && rtnval == NULL; testp++) {
X	if (!strcmp (testp -> name, funcname)) {
X	    rtnval = testp;
X 	}
X    }
X    DBUG_RETURN (rtnval);
X}
X
X
X/*
X *  FUNCTION
X *
X *	statistics   print final statistics if desired
X *
X *  PSEUDO CODE
X *
X *	Begin statistics
X *	    If a final statistics (summary) is desired then
X *		For each test in the known test list
X *		    Print the maximum error encountered
X *		End for
X *	    End if
X *	End statistics
X *
X */
X
Xstatistics ()
X{
X    struct test *tp;
X
X    DBUG_ENTER ("statistics");
X    if (sflag) {
X        for (tp = tests; tp -> name != NULL; tp++) {
X	    printf ("%s:\tmaximum relative error %le\n", 
X	    	tp -> name, tp -> max_err);
X	}
X    }
X    DBUG_VOID_RETURN;
X}
END_OF_tests/d2d.c
if test 11104 -ne `wc -c <tests/d2d.c`; then
    echo shar: \"tests/d2d.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tests/dd2d.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"tests/dd2d.c\"
else
echo shar: Extracting \"tests/dd2d.c\" \(10222 characters\)
sed "s/^X//" >tests/dd2d.c <<'END_OF_tests/dd2d.c'
X/************************************************************************
X *									*
X *				N O T I C E				*
X *									*
X *			Copyright Abandoned, 1987, Fred Fish		*
X *									*
X *	This previously copyrighted work has been placed into the	*
X *	public domain by the author (Fred Fish) and may be freely used	*
X *	for any purpose, private or commercial.  I would appreciate	*
X *	it, as a courtesy, if this notice is left in all copies and	*
X *	derivative works.  Thank you, and enjoy...			*
X *									*
X *	The author makes no warranty of any kind with respect to this	*
X *	product and explicitly disclaims any implied warranties of	*
X *	merchantability or fitness for any particular purpose.		*
X *									*
X ************************************************************************
X */
X
X/*
X *  FILE
X *
X *	dd2d.c   test dual double to double math functions
X *
X *  KEY WORDS
X *
X *	portable math library
X *	test functions
X *
X *  DESCRIPTION
X *
X *	Tests double precision functions for the Portable Math
X *	Library.  Tests those functions which expect two
X *	double precision arguments and return a double.
X *
X *	Most of the test data in the current data file (dd2d.dat)
X *	was generated using double precision FORTRAN arithmetic
X *	on a Decsystem-20.
X *
X *	Note that the ordering of functions is important for
X *	optimum error information.  Since some functions call
X *	others in the library, the functions being called should
X *	be tested first.  Naturally, an error in a lower level
X *	function will cause propagation of errors up to higher
X *	level functions.
X *
X *  USAGE
X *
X *	dd2d [-esv] [-l limit]
X *
X *		-e	=>	force error for each test
X *				to verify error handling
X *
X *		-l	=>	report errors greater than
X *				specified limit (default 10**-6)
X *
X *		-s	=>	print summary after tests
X *
X *		-v	=>	print each function, argument,
X *				and result
X *
X *	Test directives are read from the standard input, which
X *	may be redirected to the provided test file (dd2d.dat),
X *	and any relative errors are automatically written to standard
X *	output if they exceed a maximum allowable limit.
X *	Each test directive has the form:
X *
X *		<name> <arg1> <arg2> <expected result>
X *
X *	Each field is separated by a one or more space character(s).
X *	The first field, "name", is the name of the function
X *	to test (sqrt, ln, exp, etc).  The second and third fields
X *	are the arguments to use in calling the specified function.
X *	The last field is the expected result.
X *		
X *  PROGRAMMER
X *
X *	Fred Fish
X *	Tempe, Az 85281
X *	(602) 966-8871
X *
X */
X
X
X#include <stdio.h>
X
X#ifndef NODBG
X#include <dbg.h>
X#else
X#include "dbg.h"
X#endif
X
X#define TRUE 1			/* This really should be in stdio.h */
X#define FALSE 0			/* This too */
X#define MAX_ABS_ERR 1.0e-6	/* Set to catch only gross errors */
X
Xstatic int vflag;		/* Flag for verbose option */
Xstatic int eflag;		/* Simulate an error to error printout */
Xstatic int sflag;		/* Flag to show final statistics */
X
Xstatic double max_abs_err = MAX_ABS_ERR;
X
Xextern double atan2 ();
Xextern double max ();
Xextern double min ();
X
X
X/*
X *	Define all recognized test functions.  Each function
X *	must have an entry in this table, where each
X *	entry contains the information specified in the 
X *	structure "test".
X *
X */
X
Xstruct test {			/* Structure of each function to be tested */
X    char *name;			/* Name of the function to test */
X    double (*func)();		/* Pointer to the function's entry point */
X    double max_err;		/* Error accumulator for this function */
X};
X
Xstatic struct test tests[] = {	/* Table of all recognized functions */
X    "atan2", atan2, 0.0,	/* Arc tangent with two args */
X    "max", max, 0.0,		/* Maximum value */
X    "min", min, 0.0,		/* Minimum value */
X    NULL, NULL, 0.0		/* Function list end marker */
X};
X
X
X/*
X *  FUNCTION
X *
X *	main   entry point for dd2d test utility
X *
X *  PSEUDO CODE
X *
X *	Begin main
X *	    Process any options in command line.
X *	    Do all tests requested by stdin directives.
X *	    Report final statistics (if enabled).
X *	End main
X *
X */
X
Xmain (argc, argv)
Xint argc;
Xchar *argv[];
X{
X    ENTER ("main");
X    DEBUGWHO (argv[0]);
X    options (argc, argv);
X    dotests (argv);
X    statistics ();
X    LEAVE ();
X}
X
X
X/*
X *  FUNCTION
X *
X *	dotests   process each test from stdin directives
X *
X *  ERROR REPORTING
X *
X *	Note that in most cases, the error criterion is based
X *	on relative error, defined as:
X *
X *	    error = (result - expected) / expected
X *
X *	Naturally, if the expected result is zero, some
X *	other criterion must be used.  In this case, the
X *	absolute error is used.  That is:
X *
X *	    error = result
X *
X *  PSEUDO CODE
X *
X *	Begin dotests
X *	    While a test directive is successfully read from stdin
X *		Default function name to "{null}"
X *		Default argument 1 to 0.0
X *		Default argument 2 to 0.0
X *		Default expected result to 0.0
X *		Extract function name, argument and expected result
X *		Lookup test in available test list
X *		If no test was found then
X *		    Tell user that unknown function was specified
X *		Else
X *		    Call function with argument and save result
X *		    If the verify flag is set then
X *			Print function name, argument, and result
X *		    End if
X *		    If the expected result is not zero then
X *			Compute the relative error
X *		    Else
X *			Use the absolute error
X *		    End if
X *		    Get absolute value of error
X *		    If error exceeds limit or error force flag set
X *			Print error notification on stderr
X *		    End if
X *		    If this error is max for given function then
X *			Remember this error for summary
X *		    End if
X *		End if
X *	    End while
X *	End dotests
X *
X */
X
X
Xdotests (argv)
Xchar *argv[];
X{
X    char buffer[256];		/* Directive buffer */
X    char function[64];		/* Specified function name */
X    double arg1;		/* Specified function argument 1 */
X    double arg2;		/* Specified function argument 2 */
X    double expected;		/* Specified expected result */
X    double result;		/* Actual result */
X    double error;		/* Relative or absolute error */
X    double abs_err;		/* Absolute value of error */
X    struct test *testp;		/* Pointer to function test */
X    struct test *lookup ();	/* Returns function test pointer */
X    register char *strp;	/* Pointer to next token in string */
X    extern char *strtok ();
X    extern double atof ();
X
X    ENTER ("dotests");
X    while (fgets (buffer, sizeof(buffer), stdin) != NULL) {
X	strcpy (function, "{null}");
X	arg1 = 0.0;
X	arg2 = 0.0;
X	expected = 0.0;
X	sscanf (buffer, "%s %le %le %le", function, &arg1, &arg2, &expected);
X        testp = lookup (function);
X        if (testp == NULL) {
X            fprintf (stderr, "%s: unknown function \"%s\".\n",
X	    	argv[0], function);
X        } else {
X	    result = (*testp -> func)(arg1, arg2);
X	    if (vflag) {
X	        printf ("%s(%le,%le) = %30.23le.\n",
X		function, arg1, arg2, result);
X	    }
X	    if (expected != 0.0) {
X	        error = (result - expected) / expected;
X	    } else {
X	        error = result;
X	    }
X	    if (error < 0.0) {
X		abs_err = -error;
X	    } else {
X		abs_err = error;
X	    }
X            if ((abs_err > max_abs_err) || eflag) {
X		fprintf (stderr, "%s: error in \"%s\"\n", argv[0], function);
X		fprintf (stderr, "\targument 1\t%25.20le\n", arg1);
X		fprintf (stderr, "\targument 2\t%25.20le\n", arg2);
X		fprintf (stderr, "\tresult\t\t%25.20le\n", result);
X		fprintf (stderr, "\texpected\t%25.20le\n", expected);
X            }
X	    if (abs_err > testp -> max_err) {
X	        testp -> max_err = abs_err;
X	    }
X        }
X    }
X    LEAVE ();
X}
X
X
X/*
X *  FUNCTION
X *
X *	options   process command line options
X *
X *  PSEUDO CODE
X *
X *	Begin options
X *	    Reset all flags to FALSE by default
X *	    Initialize flag argument scan pointer
X *	    If there is a second command line argument then
X *		If the argument specifies flags then
X *		    While there is an unprocessed flag
X *			Switch on flag
X *			Case "force error flag":
X *			    Set the "force error" flag
X *			    Break switch
X *			Case "print summary":
X *			    Set "print summary" flag
X *			    Break switch
X *			Case "verbose":
X *			    Set "verbose" flag
X *			    Break switch
X *			Default:
X *			    Tell user unknown flag
X *			    Break switch
X *			End switch
X *		    End while
X *		End if
X *	    End if
X *	End options
X *
X */
X
X
Xoptions (argc, argv)
Xint argc;
Xchar *argv[];
X{
X    register int flag;
X    extern int getopt ();
X    extern char *optarg;
X
X    ENTER ("options");
X    eflag = sflag = vflag = FALSE;
X    while ((flag = getopt (argc, argv, "#:el:sv")) != EOF) {
X	switch (flag) {
X	    case '#':
X	        DEBUGPUSH (optarg);
X		break;
X	    case 'e':
X		eflag = TRUE;
X		break;
X	    case 'l':
X	        sscanf (optarg, "%le", &max_abs_err);
X		DEBUG3 ("args", "max_abs_err = %le", max_abs_err);
X		break;
X	    case 's':
X		sflag = TRUE;
X		break;
X	    case 'v':
X		vflag = TRUE;
X		break;
X	}
X    }
X    LEAVE ();
X}
X
X
X/*
X *  FUNCTION
X *
X *	loopup   lookup test in known test list
X *
X *  DESCRIPTION
X *
X *	Given the name of a desired test, looks up the test
X *	in the known test list and returns a pointer to the
X *	test structure.
X *
X *	Since the table is so small we simply use a linear
X *	search.
X *
X *  PSEUDO CODE
X *
X *	Begin lookup
X *	    For each known test
X *		If the test's name matches the desired test name
X *		    Return pointer to the test structure
X *		End if
X *	    End for
X *	End lookup
X *
X */
X
Xstruct test *lookup (funcname)
Xchar *funcname;
X{
X    struct test *testp;
X    struct test *rtnval;
X
X    ENTER ("lookup");
X    rtnval = (struct test *) NULL;
X    for (testp = tests; testp -> name != NULL && rtnval == NULL; testp++) {
X	if (!strcmp (testp -> name, funcname)) {
X	    rtnval = testp;
X 	}
X    }
X    LEAVE ();
X    return (rtnval);
X}
X
X
X/*
X *  FUNCTION
X *
X *	statistics   print final statistics if desired
X *
X *  PSEUDO CODE
X *
X *	Begin statistics
X *	    If a final statistics (summary) is desired then
X *		For each test in the known test list
X *		    Print the maximum error encountered
X *		End for
X *	    End if
X *	End statistics
X *
X */
X
Xstatistics ()
X{
X    struct test *tp;
X
X    ENTER ("statistics");
X    if (sflag) {
X        for (tp = tests; tp -> name != NULL; tp++) {
X	    printf ("%s:\tmaximum relative error %le\n", 
X	    	tp -> name, tp -> max_err);
X	}
X    }
X    LEAVE ();
X}
END_OF_tests/dd2d.c
if test 10222 -ne `wc -c <tests/dd2d.c`; then
    echo shar: \"tests/dd2d.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tests/unused/d2i.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"tests/unused/d2i.c\"
else
echo shar: Extracting \"tests/unused/d2i.c\" \(9030 characters\)
sed "s/^X//" >tests/unused/d2i.c <<'END_OF_tests/unused/d2i.c'
X/************************************************************************
X *									*
X *				N O T I C E				*
X *									*
X *			Copyright Abandoned, 1987, Fred Fish		*
X *									*
X *	This previously copyrighted work has been placed into the	*
X *	public domain by the author (Fred Fish) and may be freely used	*
X *	for any purpose, private or commercial.  I would appreciate	*
X *	it, as a courtesy, if this notice is left in all copies and	*
X *	derivative works.  Thank you, and enjoy...			*
X *									*
X *	The author makes no warranty of any kind with respect to this	*
X *	product and explicitly disclaims any implied warranties of	*
X *	merchantability or fitness for any particular purpose.		*
X *									*
X ************************************************************************
X */
X
X/*
X *  FILE
X *
X *	d2i.c   test portable math library functions
X *
X *  KEY WORDS
X *
X *	portable math library
X *	test functions
X *
X *  DESCRIPTION
X *
X *	Tests double precision functions for the Portable Math
X *	Library.  Tests those functions which expect a single
X *	double precision argument and return an integer.
X *
X *	Most of the test data in the current data file (d2i.dat)
X *	was generated using double precision FORTRAN arithmetic
X *	on a Decsystem-20.
X *
X *	Note that the ordering of functions is important for
X *	optimum error information.  Since some functions call
X *	others in the library, the functions being called should
X *	be tested first.
X *
X *  USAGE
X *
X *	d2i [-esv]
X *
X *		-e	=>	force error for each test
X *				to verify error handling
X *
X *		-s	=>	print summary after tests
X *
X *		-v	=>	print each function, argument,
X *				and result
X *
X *	Test directives are read from the standard input, which
X *	may be redirected to the provided test file (d2i.dat),
X *	and any relative errors are automatically written to standard
X *	output if they exceed a maximum allowable limit (specified
X *	at compile time).  Each test directive has the form:
X *
X *		<name> <argument> <expected result>
X *
X *	Each field is separated by a one or more space character(s).
X *	The first field, "name", is the name of the function
X *	to test (sqrt, ln, exp, etc).  The second field
X *	is the argument to use in calling the specified function.
X *	The third field is the expected result.
X *		
X *  PROGRAMMER
X *
X *	Fred Fish
X *	Engineering Software Tools
X *	P.O. Box 2035
X *	Tempe, Az 85281
X *	(602) 966-8871
X *
X */
X
X#include <stdio.h>
X
X#define TRUE 1			/* This really should be in stdio.h */
X#define FALSE 0			/* This too */
X#define MAX_ABS_ERR 1.0e-6	/* Set to catch only gross errors */
X
Xstatic int vflag;		/* Flag for verbose option */
Xstatic int eflag;		/* Simulate an error to check error printout */
Xstatic int sflag;		/* Flag to show final statistics */
X
Xextern int xexp();
X
X
X/*
X *	Define all recognized test functions.  Each function
X *	must have an entry in this table, where each
X *	entry contains the information specified in the 
X *	structure "test".
X *
X */
X
Xstruct test {			/* Structure of each function to be tested */
X    char *name;			/* Name of the function to test */
X    int (*func)();		/* Pointer to the function's entry point */
X    double max_err;		/* Error accumulator for this function */
X};
X
Xstatic struct test tests[] = {	/* Table of all recognized functions */
X    "xexp", xexp, 0.0,		/* Extract exponent */
X    NULL,NULL,0.0,		/* Function list end marker */
X};
X
X/*
X *  FUNCTION
X *
X *	main   entry point for d2i test utility
X *
X *  PSEUDO CODE
X *
X *	Begin main
X *	    Process any options in command line.
X *	    Do all tests requested by stdin directives.
X *	    Report final statistics (if enabled).
X *	End main
X *
X */
X
Xmain(argc,argv)
Xint argc;
Xchar *argv[];
X{
X    options(argv);
X    dotests(argv);
X    statistics();
X}
X
X/*
X *  FUNCTION
X *
X *	dotests   process each test from stdin directives
X *
X *  ERROR REPORTING
X *
X *	Note that in most cases, the error criterion is based
X *	on relative error, defined as:
X *
X *	    error = (result - expected) / expected
X *
X *	Naturally, if the expected result is zero, some
X *	other criterion must be used.  In this case, the
X *	absolute error is used.  That is:
X *
X *	    error = result
X *
X *  PSEUDO CODE
X *
X *	Begin dotests
X *	    While a test directive is successfully read from stdin
X *		Default function name to "{null}"
X *		Default argument to 0.0
X *		Default expected result to 0.0
X *		Extract function name, argument and expected result
X *		Lookup test in available test list
X *		If no test was found then
X *		    Tell user that unknown function was specified
X *		Else
X *		    Call function with argument and save result
X *		    If the verify flag is set then
X *			Print function name, argument, and result
X *		    End if
X *		    If the expected result is not zero then
X *			Compute the relative error
X *		    Else
X *			Use the absolute error
X *		    End if
X *		    Get absolute value of error
X *		    If error exceeds limit or error force flag set
X *			Print error notification on stderr
X *		    End if
X *		    If this error is max for given function then
X *			Remember this error for summary
X *		    End if
X *		End if
X *	    End while
X *	End dotests
X *
X */
X
Xdotests(argv)
Xchar *argv[];
X{
X    char buffer[128];		/* Directive buffer */
X    char function[16];		/* Specified function name */
X    double argument;		/* Specified function argument */
X    int expected;		/* Specified expected result */
X    int result;			/* Actual result */
X    int error;			/* Relative or absolute error */
X    int abs_err;		/* Absolute value of error */
X    struct test *testp;		/* Pointer to function test */
X    struct test *lookup();	/* Returns function test pointer */
X
X    while (fgets(buffer,sizeof(buffer),stdin) != NULL) {
X	strcpy(function,"{null}");
X	argument = 0.0;
X	expected = 0;
X        sscanf(buffer,"%s%F%d",&function[0],&argument,&expected);
X        testp = lookup(function);
X        if (testp == NULL) {
X            fprintf(stderr,"%s: unknown function \"%s\".\n",argv[0],function);
X        } else {
X	    result = (*testp->func)(argument);
X	    if (vflag) {
X	        printf("%s(%e) = %d\n",function,argument,result);
X	    }
X	    if (expected != 0) {
X	        error = (result - expected) / expected;
X	    } else {
X	        error = result;
X	    }
X	    if (error < 0) {
X		abs_err = -error;
X	    } else {
X		abs_err = error;
X	    }
X            if ((abs_err > MAX_ABS_ERR) || eflag) {
X                fprintf(stderr,"%s: %s(%e) = %d; should be %d\n",
X	        argv[0],function,argument,result,expected);
X            }
X	    if (abs_err > testp->max_err) {
X	        testp->max_err = abs_err;
X	    }
X        }
X    }
X}
X
X/*
X *  FUNCTION
X *
X *	options   process command line options
X *
X *  PSEUDO CODE
X *
X *	Begin options
X *	    Reset all flags to FALSE by default
X *	    Initialize flag argument scan pointer
X *	    If there is a second command line argument then
X *		If the argument specifies flags then
X *		    While there is an unprocessed flag
X *			Switch on flag
X *			Case "force error flag":
X *			    Set the "force error" flag
X *			    Break switch
X *			Case "print summary":
X *			    Set "print summary" flag
X *			    Break switch
X *			Case "verbose":
X *			    Set "verbose" flag
X *			    Break switch
X *			Default:
X *			    Tell user unknown flag
X *			    Break switch
X *			End switch
X *		    End while
X *		End if
X *	    End if
X *	End options
X *
X */
X
Xstatic char *error1[] = {
X    "%s: unknown flag '%c'\n"
X};
X
Xoptions(argv)
Xchar *argv[];
X{
X    char *argpntr;
X
X    eflag = sflag = vflag = FALSE;
X    argpntr = argv[1];
X    if (argpntr != NULL) {
X	if (*argpntr = '-') {
X	    while (*++argpntr != NULL) {
X		switch (*argpntr) {
X		case 'e':
X		    eflag = TRUE;
X		    break;
X		case 's':
X		    sflag = TRUE;
X		    break;
X		case 'v':
X		    vflag = TRUE;
X		    break;
X		default:
X		    fprintf(stderr,error1[0],argv[0],*argpntr);
X		    break;
X		}
X	    }
X	}
X    }
X}
X
X/*
X *  FUNCTION
X *
X *	loopup   lookup test in known test list
X *
X *  DESCRIPTION
X *
X *	Given the name of a desired test, looks up the test
X *	in the known test list and returns a pointer to the
X *	test structure.
X *
X *	Since the table is so small we simply use a linear
X *	search.
X *
X *  PSEUDO CODE
X *
X *	Begin lookup
X *	    For each known test
X *		If the test's name matches the desired test name
X *		    Return pointer to the test structure
X *		End if
X *	    End for
X *	End lookup
X *
X */
X
Xstruct test *lookup(funcname)
Xchar *funcname;
X{
X    struct test *testp;
X
X    for (testp = tests; testp->name != NULL; testp++) {
X	if (!strcmp(testp->name,funcname)) {
X	    return(testp);
X 	}
X    }
X    return((struct test *)NULL);
X}
X
X/*
X *  FUNCTION
X *
X *	statistics   print final statistics if desired
X *
X *  PSEUDO CODE
X *
X *	Begin statistics
X *	    If a final statistics (summary) is desired then
X *		For each test in the known test list
X *		    Print the maximum error encountered
X *		End for
X *	    End if
X *	End statistics
X *
X */
X
Xstatistics()
X{
X    struct test *tp;
X
X    if (sflag) {
X        for (tp = tests; tp->name != NULL; tp++) {
X	    printf("%s:\tmaximum relative error %e\n",tp->name,tp->max_err);
X	}
X    }
X}
END_OF_tests/unused/d2i.c
if test 9030 -ne `wc -c <tests/unused/d2i.c`; then
    echo shar: \"tests/unused/d2i.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tests/unused/di2d.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"tests/unused/di2d.c\"
else
echo shar: Extracting \"tests/unused/di2d.c\" \(9150 characters\)
sed "s/^X//" >tests/unused/di2d.c <<'END_OF_tests/unused/di2d.c'
X/************************************************************************
X *									*
X *				N O T I C E				*
X *									*
X *			Copyright Abandoned, 1987, Fred Fish		*
X *									*
X *	This previously copyrighted work has been placed into the	*
X *	public domain by the author (Fred Fish) and may be freely used	*
X *	for any purpose, private or commercial.  I would appreciate	*
X *	it, as a courtesy, if this notice is left in all copies and	*
X *	derivative works.  Thank you, and enjoy...			*
X *									*
X *	The author makes no warranty of any kind with respect to this	*
X *	product and explicitly disclaims any implied warranties of	*
X *	merchantability or fitness for any particular purpose.		*
X *									*
X ************************************************************************
X */
X
X/*
X *  FILE
X *
X *	di2d.c   test some portable math library functions
X *
X *  KEY WORDS
X *
X *	portable math library
X *	test functions
X *
X *  DESCRIPTION
X *
X *	Tests double precision functions for the Portable Math
X *	Library.  Tests those functions which expect a double
X *	precision argument, followed by an integer argument, and
X *	return a double.
X *
X *	Most of the test data in the current data file (di2d.dat)
X *	was generated using double precision FORTRAN arithmetic
X *	on a Decsystem-20.
X *
X *	Note that the ordering of functions is important for
X *	optimum error information.  Since some functions call
X *	others in the library, the functions being called should
X *	be tested first.
X *
X *  USAGE
X *
X *	di2d [-esv]
X *
X *		-e	=>	force error for each test
X *				to verify error handling
X *
X *		-s	=>	print summary after tests
X *
X *		-v	=>	print each function, argument,
X *				and result
X *
X *	Test directives are read from the standard input, which
X *	may be redirected to the provided test file (di2d.dat),
X *	and any relative errors are automatically written to standard
X *	output if they exceed a maximum allowable limit (specified
X *	at compile time).  Each test directive has the form:
X *
X *		<name> <arg1> <arg2> <expected result>
X *
X *	Each field is separated by a one or more space character(s).
X *	The first field, "name", is the name of the function
X *	to test (sqrt, ln, exp, etc).  The second field
X *	is the argument to use in calling the specified function.
X *	The third field is the expected result.
X *		
X *  PROGRAMMER
X *
X *	Fred Fish
X *	Engineering Software Tools
X *	P.O. Box 2035
X *	Tempe, Az 85281
X *	(602) 966-8871
X *
X */
X
X#include <stdio.h>
X
X#define TRUE 1			/* This really should be in stdio.h */
X#define FALSE 0			/* This too */
X#define MAX_ABS_ERR 1.0e-6	/* Set to catch only gross errors */
X
Xstatic int vflag;		/* Flag for verbose option */
Xstatic int eflag;		/* Simulate an error to check error printout */
Xstatic int sflag;		/* Flag to show final statistics */
X
Xextern double scale();
X
X
X/*
X *	Define all recognized test functions.  Each function
X *	must have an entry in this table, where each
X *	entry contains the information specified in the 
X *	structure "test".
X *
X */
X
Xstruct test {			/* Structure of each function to be tested */
X    char *name;			/* Name of the function to test */
X    double (*func)();		/* Pointer to the function's entry point */
X    double max_err;		/* Error accumulator for this function */
X};
X
Xstatic struct test tests[] = {	/* Table of all recognized functions */
X    "scale", scale, 0.0,	/* Scale a double by specified exponent */
X    NULL,NULL,0.0,		/* Function list end marker */
X};
X
X/*
X *  FUNCTION
X *
X *	main   entry point for di2d test utility
X *
X *  PSEUDO CODE
X *
X *	Begin main
X *	    Process any options in command line.
X *	    Do all tests requested by stdin directives.
X *	    Report final statistics (if enabled).
X *	End main
X *
X */
X
Xmain(argc,argv)
Xint argc;
Xchar *argv[];
X{
X    options(argv);
X    dotests(argv);
X    statistics();
X}
X
X/*
X *  FUNCTION
X *
X *	dotests   process each test from stdin directives
X *
X *  ERROR REPORTING
X *
X *	Note that in most cases, the error criterion is based
X *	on relative error, defined as:
X *
X *	    error = (result - expected) / expected
X *
X *	Naturally, if the expected result is zero, some
X *	other criterion must be used.  In this case, the
X *	absolute error is used.  That is:
X *
X *	    error = result
X *
X *  PSEUDO CODE
X *
X *	Begin dotests
X *	    While a test directive is successfully read from stdin
X *		Default function name to "{null}"
X *		Default argument to 0.0
X *		Default expected result to 0.0
X *		Extract function name, argument and expected result
X *		Lookup test in available test list
X *		If no test was found then
X *		    Tell user that unknown function was specified
X *		Else
X *		    Call function with argument and save result
X *		    If the verify flag is set then
X *			Print function name, argument, and result
X *		    End if
X *		    If the expected result is not zero then
X *			Compute the relative error
X *		    Else
X *			Use the absolute error
X *		    End if
X *		    Get absolute value of error
X *		    If error exceeds limit or error force flag set
X *			Print error notification on stderr
X *		    End if
X *		    If this error is max for given function then
X *			Remember this error for summary
X *		    End if
X *		End if
X *	    End while
X *	End dotests
X *
X */
X
Xdotests(argv)
Xchar *argv[];
X{
X    char buffer[128];		/* Directive buffer */
X    char function[16];		/* Specified function name */
X    double arg1;		/* Specified function argument */
X    int arg2;			/* Specified function argument #2 */
X    double expected;		/* Specified expected result */
X    double result;		/* Actual result */
X    double error;		/* Relative or absolute error */
X    double abs_err, abs();	/* Absolute value of error */
X    struct test *testp;		/* Pointer to function test */
X    struct test *lookup();	/* Returns function test pointer */
X
X    while (fgets(buffer,sizeof(buffer),stdin) != NULL) {
X	strcpy(function,"{null}");
X	arg1 = 0.0;
X	arg2 = 0;
X	expected = 0.0;
X        sscanf(buffer,"%s%F%d%F",&function[0],&arg1,&arg2,&expected);
X        testp = lookup(function);
X        if (testp == NULL) {
X            fprintf(stderr,"%s: unknown function \"%s\".\n",argv[0],function);
X        } else {
X	    result = (*testp->func)(arg1,arg2);
X	    if (vflag) {
X	        printf("%s(%e,%d) = %25.18e.\n",function,arg1,arg2,result);
X	    }
X	    if (expected != 0.0) {
X	        error = (result - expected) / expected;
X	    } else {
X	        error = result;
X	    }
X	    abs_err = abs(error);
X            if ((abs_err > MAX_ABS_ERR) || eflag) {
X                fprintf(stderr,"%s: %s(%e,%d) = %20.15e; should be %20.15e.\n",
X	        argv[0],function,arg1,arg2,result,expected);
X            }
X	    if (abs_err > testp->max_err) {
X	        testp->max_err = abs_err;
X	    }
X        }
X    }
X}
X
X/*
X *  FUNCTION
X *
X *	options   process command line options
X *
X *  PSEUDO CODE
X *
X *	Begin options
X *	    Reset all flags to FALSE by default
X *	    Initialize flag argument scan pointer
X *	    If there is a second command line argument then
X *		If the argument specifies flags then
X *		    While there is an unprocessed flag
X *			Switch on flag
X *			Case "force error flag":
X *			    Set the "force error" flag
X *			    Break switch
X *			Case "print summary":
X *			    Set "print summary" flag
X *			    Break switch
X *			Case "verbose":
X *			    Set "verbose" flag
X *			    Break switch
X *			Default:
X *			    Tell user unknown flag
X *			    Break switch
X *			End switch
X *		    End while
X *		End if
X *	    End if
X *	End options
X *
X */
X
Xstatic char *error1[] = {
X    "%s: unknown flag '%c'\n"
X};
X
Xoptions(argv)
Xchar *argv[];
X{
X    char *argpntr;
X
X    eflag = sflag = vflag = FALSE;
X    argpntr = argv[1];
X    if (argpntr != NULL) {
X	if (*argpntr = '-') {
X	    while (*++argpntr != NULL) {
X		switch (*argpntr) {
X		case 'e':
X		    eflag = TRUE;
X		    break;
X		case 's':
X		    sflag = TRUE;
X		    break;
X		case 'v':
X		    vflag = TRUE;
X		    break;
X		default:
X		    fprintf(stderr,error1[0],argv[0],*argpntr);
X		    break;
X		}
X	    }
X	}
X    }
X}
X
X/*
X *  FUNCTION
X *
X *	loopup   lookup test in known test list
X *
X *  DESCRIPTION
X *
X *	Given the name of a desired test, looks up the test
X *	in the known test list and returns a pointer to the
X *	test structure.
X *
X *	Since the table is so small we simply use a linear
X *	search.
X *
X *  PSEUDO CODE
X *
X *	Begin lookup
X *	    For each known test
X *		If the test's name matches the desired test name
X *		    Return pointer to the test structure
X *		End if
X *	    End for
X *	End lookup
X *
X */
X
Xstruct test *lookup(funcname)
Xchar *funcname;
X{
X    struct test *testp;
X
X    for (testp = tests; testp->name != NULL; testp++) {
X	if (!strcmp(testp->name,funcname)) {
X	    return(testp);
X 	}
X    }
X    return((struct test *)NULL);
X}
X
X/*
X *  FUNCTION
X *
X *	statistics   print final statistics if desired
X *
X *  PSEUDO CODE
X *
X *	Begin statistics
X *	    If a final statistics (summary) is desired then
X *		For each test in the known test list
X *		    Print the maximum error encountered
X *		End for
X *	    End if
X *	End statistics
X *
X */
X
Xstatistics()
X{
X    struct test *tp;
X
X    if (sflag) {
X        for (tp = tests; tp->name != NULL; tp++) {
X	    printf("%s:\tmaximum relative error %e\n",tp->name,tp->max_err);
X	}
X    }
X}
END_OF_tests/unused/di2d.c
if test 9150 -ne `wc -c <tests/unused/di2d.c`; then
    echo shar: \"tests/unused/di2d.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 5 \(of 6\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 6 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 6 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0
-- 
= Drug tests; just say *NO*!  (Moto just announced new drug testing program)  =
= Fred Fish  Motorola Computer Division, 3013 S 52nd St, Tempe, Az 85282  USA =
= seismo!noao!mcdsun!fnf    (602) 438-5976                                    =