Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/unix/volume26/calc/part08

Text File | 1992-05-09 | 39.8 KB | 1,504 lines

Newsgroups: comp.sources.unix
From: [e-mail] (David I. Bell)
Subject: v26i034: CALC - An arbitrary precision C-like calculator, Part08/21
Sender: [e-mail]
Approved: [e-mail]

Submitted-By: [e-mail] (David I. Bell)
Posting-Number: Volume 26, Issue 34
Archive-Name: calc/part08

#! /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 8 (of 21)."
# Contents:  input.c lib/regress.cal
# Wrapped by dbell@elm on Tue Feb 25 15:21:03 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'input.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'input.c'\"
else
echo shar: Extracting \"'input.c'\" \(17693 characters\)
sed "s/^X//" >'input.c' <<'END_OF_FILE'
X/*
X * Copyright (c) 1992 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Nested input source file reader.
X * For terminal input, this also provides a simple command stack.
X */
X
X#include <ctype.h>
X#include <pwd.h>
X#include "calc.h"
X#include "config.h"
X
X#define MAXSAVE        255    /* number of saved terminal lines */
X#define DEFHIST        20    /* default history length display */
X#define TTYSIZE        100    /* reallocation size for terminal buffers */
X#define DEPTH        10    /* maximum depth of input */
X#define IS_READ        1    /* reading normally */
X#define IS_REREAD    2    /* reread current character */
X#define chartoint(ch)    ((ch) & 0xff)    /* make sure char is not negative */
X
X
Xtypedef struct {
X    short i_state;        /* state (read, reread) */
X    short i_char;        /* currently read char */
X    long i_line;        /* line number */
X    char *i_str;        /* current string for input (if not NULL) */
X    char *i_origstr;    /* original string so it can be freed */
X    char *i_ttystr;        /* current character of tty line (or NULL) */
X    FILE *i_fp;        /* current file for input (if not NULL) */
X    char *i_name;        /* file name if known */
X} INPUT;
X
X
Xstatic int stacksize;        /* number of elements in command stack */
Xstatic int stackindex;        /* current index into command stack */
Xstatic int cmdsize;        /* current max size of terminal buffer */
Xstatic int editsize;        /* current max size of edit buffer */
Xstatic int linesize;        /* current max size of input line */
Xstatic char *linebuf;        /* current input line buffer */
Xstatic char *cmdbuf;        /* current command line buffer */
Xstatic char *editbuf;        /* edit buffer */
Xstatic char **cmdstack;        /* command stack */
Xstatic char *prompt;        /* current prompt for terminal */
Xstatic BOOL noprompt;        /* TRUE if should not print prompt */
X
Xstatic int depth;        /* current input depth */
Xstatic INPUT *cip;        /* current input source */
Xstatic INPUT inputs[DEPTH];    /* input sources */
X
X
Xstatic char *findhistory(), *edithistory();
Xstatic int openfile();
Xstatic int ttychar();
X
Xextern struct passwd *getpwnam();
X
X
X/*
X * Open an input file by possibly searching through a path list
X * and also possibly applying the specified extension.  For example:
X * opensearchfile("barf", ".:/tmp", ".c") searches in order for the
X * files "./barf", "./barf.c", "/tmp/barf", and "/tmp/barf.c".
X *
X * Returns -1 if all specified files cannot be opened.
X */
Xopensearchfile(name, pathlist, extension)
X    char *name;        /* file name to be read */
X    char *pathlist;        /* list of colon separated paths (or NULL) */
X    char *extension;    /* extra extension to try (or NULL) */
X{
X    int i;
X    char *cp;
X    char path[PATHSIZE+1];    /* name being searched for */
X
X    /*
X     * Don't try the extension if the filename already contains it.
X     */
X    if (extension) {
X        i = strlen(name) - strlen(extension);
X        if ((i >= 0) && (strcmp(&name[i], extension) == 0))
X            extension = NULL;
X    }
X    /*
X     * If the name is absolute, or if there is no path list, then
X     * make one which just searches for the name straight.  Then
X     * search through the path list for the file, without and with
X     * the specified extension.
X     */
X    if (name[0] == PATHCHAR ||
X        name[0] == HOMECHAR ||
X        (name[0] == DOTCHAR && name[1] == PATHCHAR) ||
X        pathlist == NULL) {
X        pathlist = "";
X    }
X    pathlist--;
X    do {
X        pathlist++;
X        cp = path;
X        while (*pathlist && (*pathlist != LISTCHAR))
X            *cp++ = *pathlist++;
X        if (cp != path)
X            *cp++ = PATHCHAR;
X        strcpy(cp, name);
X        i = openfile(path);
X        if ((i < 0) && extension) {
X            strcat(path, extension);
X            i = openfile(path);
X        }
X    } while ((i < 0) && *pathlist);
X    return i;
X}
X
X
X/*
X * Given a filename with a leading ~, expand it into a home directory for
X * that user.  This function will malloc the space for the expanded path.
X *
X * If the path is just ~, or begins with ~/, expand it to the home
X * directory of the current user.  If the environment variable $HOME
X * is known, it will be used, otherwise the password file will be
X * consulted.
X *
X * If the path is just ~username, or ~username/, expand it to the home
X * directory of that user by looking it up in the password file.
X *
X * If the password file must be consulted and the username is not found
X * a NULL pointer is returned.
X */
Xstatic char *
Xhomeexpand(name)
X    char *name;        /* a filename with a leading ~ */
X{
X    struct passwd *ent;    /* password entry */
X    char *home2;        /* fullpath of the home directory */
X    char *fullpath;        /* the malloced expanded path */
X    char *after;        /* after the ~user or ~ */
X    char username[PATHSIZE+1];    /* extratced username */
X
X    /* firewall */
X    if (name[0] != HOMECHAR)
X        return NULL;
X
X    /*
X     * obtain the home directory component
X     */
X    switch (name[1]) {
X    case PATHCHAR:        /* ~/... */
X    case '\0':        /* ~ */
X        home2 = home;
X        after = name+1;
X        break;
X    default:        /* ~username or ~username/... */
X
X        /* extract the username after the ~ */
X        after = (char *)strchr(name+2, PATHCHAR);
X        if (after == NULL) {
X            /* path is just ~username */
X            ent = getpwnam(name+1);
X            if (ent == NULL) {
X                /* unknown user */
X                return NULL;
X            }
X            /* just malloc the home directory and return it */
X            fullpath = (char *)malloc(strlen(ent->pw_dir)+1);
X            strcpy(fullpath, ent->pw_dir);
X            return fullpath;
X        }
X        if (after-name > PATHSIZE+1) {
X            /* username is too big */
X            return NULL;
X        }
X        strncpy(username, name+1, after-name-1);
X        username[after-name-1] = '\0';
X
X        /* get that user's home directory */
X        ent = getpwnam(username);
X        if (ent == NULL) {
X            /* unknown user */
X            return NULL;
X        }
X        home2 = ent->pw_dir;
X        break;
X    }
X
X    /*
X     * build the fullpath given the home directory
X     */
X    fullpath = (char *)malloc(strlen(home2)+strlen(after)+1);
X    sprintf(fullpath, "%s%s", home2, after);
X    return fullpath;
X}
X
X
X/*
X * f_open - ~-expand a filename and fopen() it
X */
XFILE *
Xf_open(name, mode)
X    char *name;        /* the filename to open */
X    char *mode;        /* the fopen mode to use */
X{
X    FILE *fp;        /* open file descriptor */
X    char *fullname;        /* file name with HOMECHAR expansion */
X
X    /*
X     * expand ~ if needed
X     */
X    if (name[0] == HOMECHAR) {
X        fullname = homeexpand(name);
X        if (fullname == NULL)
X            return NULL;
X        fp = fopen(fullname, mode);
X        free(fullname);
X    } else {
X        fp = fopen(name, mode);
X    }
X    return fp;
X}
X
X
X/*
X * Setup for reading from a input file.
X * Returns -1 if file could not be opened.
X */
Xstatic
Xopenfile(name)
X    char *name;        /* file name to be read */
X{
X    FILE *fp;        /* open file descriptor */
X
X    if (depth >= DEPTH)
X         return -1;
X    fp = f_open(name, "r");
X    if (fp == NULL)
X         return -1;
X    cip++;
X    cip->i_state = IS_READ;
X    cip->i_char = '\0';
X    cip->i_str = NULL;
X    cip->i_origstr = NULL;
X    cip->i_ttystr = NULL;
X    cip->i_fp = fp;
X    cip->i_line = 1;
X    cip->i_name = (char *)malloc(strlen(name) + 1);
X    strcpy(cip->i_name, name);
X    depth++;
X    return 0;
X}
X
X
X/*
X * Open a string for scanning. String is ended by a null character.
X * String is copied into local memory so it can be trashed afterwards.
X * Returns -1 if cannot open string.
X */
Xopenstring(str)
X    char *str;        /* string to be opened */
X{
X    char *cp;        /* copied string */
X
X    if ((depth >= DEPTH) || (str == NULL))
X         return -1;
X    cp = (char *)malloc(strlen(str) + 1);
X    if (cp == NULL)
X         return -1;
X    strcpy(cp, str);
X    cip++;
X    cip->i_state = IS_READ;
X    cip->i_char = '\0';
X    cip->i_str = cp;
X    cip->i_origstr = cp;
X    cip->i_fp = NULL;
X    cip->i_name = NULL;
X    cip->i_ttystr = NULL;
X    cip->i_line = 1;
X    depth++;
X    return 0;
X}
X
X
X/*
X * Set to read input from the terminal.
X * Returns -1 if there is no more depth for input.
X */
Xopenterminal()
X{
X    if (depth >= DEPTH)
X         return -1;
X    if (cmdsize == 0) {
X        cmdbuf = (char *)malloc(TTYSIZE + 1);
X        if (cmdbuf == NULL)
X            return -1;
X        cmdsize = TTYSIZE;
X    }
X    if (editsize == 0) {
X        editbuf = (char *)malloc(TTYSIZE + 1);
X        if (editbuf == NULL)
X            return -1;
X        editsize = TTYSIZE;
X    }
X    if (stacksize == 0) {
X        cmdstack = (char **) malloc(MAXSAVE * sizeof(char *));
X        if (cmdstack == NULL)
X            return -1;
X        stacksize = MAXSAVE;
X        for (stackindex = 0; stackindex < MAXSAVE; stackindex++)
X            cmdstack[stackindex] = NULL;
X        stackindex = 0;
X    }
X    cip++;
X    cip->i_state = IS_READ;
X    cip->i_char = '\0';
X    cip->i_str = NULL;
X    cip->i_origstr = NULL;
X    cip->i_ttystr = NULL;
X    cip->i_fp = NULL;
X    cip->i_name = NULL;
X    cip->i_line = 1;
X    depth++;
X    return 0;
X}
X
X
X/*
X * Close the current input source.
X */
Xstatic void
Xcloseinput()
X{
X    if (depth <= 0)
X        return;
X    if (cip->i_origstr)
X        free(cip->i_origstr);
X    if (cip->i_fp)
X        fclose(cip->i_fp);
X    if (cip->i_name)
X        free(cip->i_name);
X    cip--;
X    depth--;
X}
X
X
X/*
X * Reset the input sources back to the initial state.
X */
Xvoid
Xresetinput()
X{
X    while (depth > 0)
X        closeinput();
X    cip = inputs;
X    noprompt = FALSE;
X}
X
X
X/*
X * Set the prompt for terminal input.
X */
Xvoid
Xsetprompt(str)
X    char *str;
X{
X    prompt = str;
X    noprompt = FALSE;
X}
X
X
X/*
X * Read the next character from the current input source.
X * End of file returns newline character and closes current input source,
X * except for the last input source, which returns EOF.
X */
Xint
Xnextchar()
X{
X    int ch;            /* current input character */
X
X    if (depth == 0)        /* input finished */
X         return EOF;
X    if (cip->i_state == IS_REREAD) {    /* rereading current char */
X         ch = cip->i_char;
X         cip->i_state = IS_READ;
X         if (ch == '\n')
X            cip->i_line++;
X         return ch;
X    }
X    if (cip->i_str) {        /* from string */
X        ch = chartoint(*cip->i_str++);
X        if (ch == '\0')
X            ch = EOF;
X    } else if (cip->i_fp) {        /* from file */
X        ch = fgetc(cip->i_fp);
X    } else {            /* from terminal */
X        ch = ttychar();
X    }
X    if (ch == EOF) {        /* fix up end of file */
X        closeinput();
X        ch = '\n';
X        if (depth <= 0)
X            ch = EOF;
X    }
X    if (depth > 0)
X        cip->i_char = (char)ch;    /* save for rereads */
X    if (ch == '\n')
X        cip->i_line++;
X    return ch;
X}
X
X
X/*
X * Read in the next line of input from the current input source.
X * The line is terminated with a null character, and does not contain
X * the final newline character.  The returned string is only valid
X * until the next such call, and so must be copied if necessary.
X * Returns NULL on end of file.
X */
Xchar *
Xnextline()
X{
X    char *cp;
X    int ch;
X    int len;
X
X    cp = linebuf;
X    if (linesize == 0) {
X        cp = (char *)malloc(TTYSIZE + 1);
X        if (cp == NULL)
X            error("Cannot allocate line buffer");
X        linebuf = cp;
X        linesize = TTYSIZE;
X    }
X    len = 0;
X    for (;;) {
X        noprompt = TRUE;
X        ch = nextchar();
X        noprompt = FALSE;
X        if (ch == EOF)
X            return NULL;
X        if (ch == '\0')
X            continue;
X        if (ch == '\n')
X            break;
X        if (len >= linesize) {
X            cp = (char *)realloc(cp, linesize + TTYSIZE + 1);
X            if (cp == NULL)
X                error("Cannot realloc line buffer");
X            linebuf = cp;
X            linesize += TTYSIZE;
X        }
X        cp[len++] = (char)ch;
X    }
X    cp[len] = '\0';
X    return linebuf;
X}
X
X
X/*
X * Read the next character from the terminal.
X * This works by reading in a complete line from the terminal at once,
X * and then returns the characters one by one as required.  If the line
X * begins with the special command stack history character, then it is
X * replaced by some previous command line.  The saved line is then put on
X * the command stack for future reference.
X */
Xstatic int
Xttychar()
X{
X    int ch;            /* current char */
X    int len;        /* length of current command */
X    char *newbuf;        /* new buffer */
X
X    /*
X     * If we have more to read from the saved command line, then do that.
X     * When we see a newline character, then clear the pointer so we will
X     * read a new line on the next call.
X     */
X    if (cip->i_ttystr) {
X        ch = chartoint(*cip->i_ttystr++);
X        if (ch == '\n')
X            cip->i_ttystr = NULL;
X        return ch;
X    }
X    /*
X     * We need another complete line.  Print the prompt string, then read
X     * in a new command line, expanding the command buffer as necessary.
X     */
X    if (!noprompt) {
X        printf("%02d%s", stackindex + 1, prompt);
X        fflush(stdout);
X    }
X    abortlevel = 0;
X    len = 0;
X    do {
X        if (len >= cmdsize) {
X            newbuf = (char *)realloc(cmdbuf, cmdsize + TTYSIZE + 1);
X            if (newbuf == NULL) {
X                perror("Cannot reallocate terminal buffer");
X                return EOF;
X            }
X            cmdbuf = newbuf;
X            cmdsize += TTYSIZE;
X        }
X        inputwait = TRUE;
X        ch = getchar();
X        inputwait = FALSE;
X        if (ch == EOF)
X            return EOF;
X        ch = chartoint(ch);
X        if (ch)
X            cmdbuf[len++] = (char)ch;
X    } while (ch != '\n');
X    cmdbuf[len] = '\0';
X    /*
X     * If the line was blank, then just return the line feed and do not
X     * put the line on the command stack.
X     */
X    if (len == 1)
X        return '\n';
X    /*
X     * Handle shell escape if present
X     */
X    if (cmdbuf[0] == '!') {        /* do a shell command */
X        char *cmd;
X
X        cmd = cmdbuf + 1;
X        if (*cmd == '\0' || *cmd == '\n')
X            cmd = shell;
X        system(cmd);
X        return '\n';
X    /*
X     * Handle history command if present.
X     */
X    } else if (cmdbuf[0] == '`') {
X        cmdbuf[len-1] = '\0';
X        newbuf = findhistory(cmdbuf + 1);
X        if (newbuf == NULL)
X            return '\n';
X        strcpy(cmdbuf, newbuf);
X    }
X    /*
X     * Save the line in the command stack.
X     */
X    newbuf = (char *)malloc(strlen(cmdbuf) + 1);
X    if (newbuf == NULL) {
X        perror("Cannot save history line");
X        return EOF;
X    }
X    strcpy(newbuf, cmdbuf);
X    if (cmdstack[stackindex])
X        free(cmdstack[stackindex]);
X    cmdstack[stackindex] = newbuf;
X    stackindex = (stackindex + 1) % MAXSAVE;
X    /*
X     * Return the first character of the line, and set up to
X     * return the rest of it with later calls.
X     */
X    cip->i_ttystr = cmdbuf + 1;
X    return chartoint(cmdbuf[0]);
X}
X
X
X/*
X * Parse a history command line, and return the selected command.
X * NULL is returned if the history command is invalid. Legal formats:
X *    ``    The previous command.
X *    `n    Command number n.
X *    `-n    The nth command back.
X *    `h n    List last n history elements.
X *    `e n    Edit command n (last if not given).
X */
Xstatic char *
Xfindhistory(cmd)
X    char *cmd;        /* history command */
X{
X    int num;        /* command number */
X    int action;        /* action character */
X    int back;        /* how much to search backwards */
X    char *str;        /* returned string */
X
X    num = 0;
X    if ((*cmd == '`') && (cmd[1] == '\0')) {
X        num = stackindex - 1;
X        if (num < 0)
X            num += MAXSAVE;
X        str = cmdstack[num];
X        if (str == NULL)
X            fprintf(stderr, "No previous command\n");
X        return str;
X    }
X    action = '\0';
X    if (isascii(*cmd) && islower(*cmd))
X        action = *cmd++;
X    else if (isascii(*cmd) && isupper(*cmd))
X        action = tolower(*cmd++);
X    while (isascii(*cmd) && isspace(*cmd))
X        cmd++;
X    back = FALSE;
X    if (*cmd == '-') {
X        back = TRUE;
X        cmd++;
X    }
X    num = 0;
X    while ((*cmd >= '0') && (*cmd <= '9'))
X        num = num * 10 + (*cmd++ - '0');
X    if (*cmd != '\0' && *cmd != '\n') {
X        fprintf(stderr, "Invalid history command format\n");
X        return NULL;
X    }
X    if ((num == 0) && (action == 'h'))
X        num = DEFHIST;
X    if ((num == 0) && (action == 'e'))
X        num = stackindex;
X    if ((num <= 0) || (num > MAXSAVE)) {
X        fprintf(stderr, "Invalid history command number\n");
X        return NULL;
X    }
X    if (back)
X        num = stackindex - num;
X    else
X        num--;
X    if (num < 0)
X        num += MAXSAVE;
X    switch (action) {
X        case '\0':
X            str = cmdstack[num];
X            if (str == NULL)
X                fprintf(stderr, "History stack element %d is undefined\n", num + 1);
X            return str;
X
X        case 'e':
X            return edithistory(cmdstack[num]);
X
X        case 'h':
X            num++;
X            back = stackindex - num;
X            if (back < 0)
X                back += MAXSAVE;
X            printf("\n");
X            while (num-- > 0) {
X                if (cmdstack[back])
X                printf("%02d: %s", back + 1, cmdstack[back]);
X                back = (back + 1) % MAXSAVE;
X            }
X            printf("\n");
X            return NULL;
X
X        default:
X            fprintf(stderr, "Invalid history action character");
X            return NULL;
X    }
X}
X
X
X/*
X * Edit the specified command string and return the new version of it.
X * The string is safe to reference until the next call to this routine.
X * Returns NULL if the user gives the command to abort the edit.
X */
X/*ARGSUSED*/
Xstatic char *
Xedithistory(str)
X    char *str;        /* original string */
X{
X#if 0
X    char *tmp;        /* temporary string */
X    int len;        /* current length of string */
X    int cmd;        /* edit command */
X#endif
X
X    printf("Editing not implemented\n");
X    return NULL;
X#if 0
X    len = strlen(str);
X    if (len >= editsize) {
X        tmp = realloc(editbuf, len + TTYSIZE + 1);
X        if (tmp == NULL) {
X            perror("Cannot grow edit line");
X            return NULL;
X        }
X        free(editbuf);
X        editbuf = tmp;
X        editsize = len + TTYSIZE;
X    }
X    strcpy(editbuf, str);
X    for (;;) {
X        printf(" %s*", editbuf);
X        fflush(stdout);
X        cmd = getchar();
X        switch (cmd) {
X            case EOF:
X                return NULL;
X            case '\n':
X                return editbuf;
X            default:
X                while (getchar() != '\n') ;
X                printf("Bad edit command\n");
X        }
X    }
X#endif
X}
X
X
X/*
X * Return whether or not the input source is the terminal.
X */
XBOOL
Xinputisterminal()
X{
X    return ((depth <= 0) || ((cip->i_str == NULL) && (cip->i_fp == NULL)));
X}
X
X
X/*
X * Return the name of the current input file.
X * Returns NULL for terminal or strings.
X */
Xchar *
Xinputname()
X{
X    if (depth <= 0)
X        return NULL;
X    return cip->i_name;
X}
X
X
X/*
X * Return the current line number.
X */
Xlong
Xlinenumber()
X{
X    if (depth > 0)
X        return cip->i_line;
X    return 1;
X}
X
X
X/*
X * Restore the next character to be read again on the next nextchar call.
X */
Xvoid
Xreread()
X{
X    if ((depth <= 0) || (cip->i_state == IS_REREAD))
X        return;
X    cip->i_state = IS_REREAD;
X    if (cip->i_char == '\n')
X        cip->i_line--;
X}
X
X
X/*
X * Process all startup files found in the $CALCRC path.
X */
Xvoid
Xrunrcfiles()
X{
X    char path[PATHSIZE+1];    /* name being searched for */
X    char *cp;
X    char *newcp;
X    char *p;
X    int i;
X
X    /* execute each file in the list */
X    for (cp=calcrc, newcp=(char *)strchr(calcrc, LISTCHAR);
X         cp != NULL && *cp;
X         cp = newcp,
X         newcp=(newcp) ? (char *)strchr(newcp+1, LISTCHAR) : NULL) {
X
X        /* load file name into the path */
X        if (newcp == NULL) {
X            strcpy(path, cp);
X        } else {
X            strncpy(path, cp, newcp-cp);
X            path[newcp-cp] = '\0';
X        }
X
X        /* find the start of the path */
X        p = (path[0] == ':') ? path+1 : path;
X        if (p[0] == '\0') {
X            continue;
X        }
X
X        /* process the current file in the list */
X        i = openfile(p);
X        if (i < 0)
X            continue;
X        getcommands();
X    }
X}
X
X
X/* END CODE */
END_OF_FILE
if test 17693 -ne `wc -c <'input.c'`; then
    echo shar: \"'input.c'\" unpacked with wrong size!
fi
# end of 'input.c'
fi
if test -f 'lib/regress.cal' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lib/regress.cal'\"
else
echo shar: Extracting \"'lib/regress.cal'\" \(19555 characters\)
sed "s/^X//" >'lib/regress.cal' <<'END_OF_FILE'
X/*
X * Copyright (c) 1992 David I. Bell
X * Permission is granted to use, distribute, or modify this source,
X * provided that this copyright notice remains intact.
X *
X * Test the correct execution of the calculator by reading this library file.
X * Errors are reported with '****' messages, or worse.  :-)
X *
X * NOTE: Unlike most calc lib files, this one performs its work when
X *       it is read.  Normally one would just define functions and
X *     values for later use.  In the case of the regression test,
X *     we do not want to do this.
X */
X
Xdefine verify(test, str)
X{
X    if (test != 1) {
X        print '**** Non-true result (' : test : '): ' : str;
X        return;
X    }
X    print str;
X}
X
X
Xdefine error(str)
X{
X    print '****' , str;
X}
X
X
Xdefine getglobalvar()
X{
X    global    globalvar;
X
X    return globalvar;
X}
X
X
X/*
X * Test boolean operations and IF tests.
X */
Xdefine test_booleans()
X{
X    local    x;
X    local    y;
X    local    t1, t2, t3;
X
X    print '100: Beginning test_booleans';
X
X    if (0)
X        print '**** if (0)';
X
X    if (1)
X        print '101: if (1)';
X
X    if (2)
X        print '102: if (2)';
X
X    if (1)
X        print '103: if (1) else';
X    else
X        print '**** if (1) else';
X
X    if (0)
X        print '**** if (0) else';
X    else
X        print '104: if (0) else';
X
X    if (1 == 1)
X        print '105: if 1 == 1';
X    else
X        print '**** if 1 == 1';
X
X    if (1 != 2)
X        print '106: if 1 != 2';
X    else
X        print '**** if 1 != 2';
X
X    verify(1,      '107: verify 1');
X    verify(2 == 2, '108: verify 2 == 2');
X    verify(2 != 3, '109: verify 2 != 3');
X    verify(2 <  3, '110: verify 2 <  3');
X    verify(2 <= 2, '111: verify 2 <= 2');
X    verify(2 <= 3, '112: verify 2 <= 3');
X    verify(3 >  2, '113: verify 3 >  2');
X    verify(2 >= 2, '114: verify 2 >= 2');
X    verify(3 >= 2, '115: verify 3 >= 2');
X    verify(!0,     '116: verify !0');
X    verify(!1 == 0,'117: verify !1 == 0');
X    print '118: Ending test_booleans';
X}
X
X
X/*
X * Test variables and simple assignments.
X */
Xdefine test_variables()
X{
X    local    x1, x2, x3;
X    global    g1, g2;
X    local    t;
X    global    globalvar;
X
X    print '200: Beginning test_variables';
X    x1 = 5;
X    x3 = 7 * 2;
X    x2 = 9 + 1;
X    globalvar = 22;
X    g1 = 19 - 3;
X    g2 = 79;
X    verify(x1 == 5,  '201: x1 == 5');
X    verify(x2 == 10, '202: x2 == 10');
X    verify(x3 == 14, '203: x3 == 14');
X    verify(g1 == 16, '204: g1 == 16');
X    verify(g2 == 79, '205: g2 == 79');
X    verify(globalvar == 22, '204: globalvar == 22');
X    verify(getglobalvar() == 22, '205: getglobalvar() == 22');
X    x1 = x2 + x3 + g1;
X    verify(x1 == 40, '206: x1 == 40');
X    g1 = x3 + g2;
X    verify(g1 == 93, '207: g1 == 207');
X    x1 = 5;
X    verify(x1++ == 5, '208: x1++ == 5');
X    verify(x1 == 6, '209: x1 == 6');
X    verify(++x1 == 7, '210: ++x1 == 7');
X    x1 += 3;
X    verify(x1 == 10, '211: x1 == 10');
X    x1 -= 6;
X    verify(x1 == 4, '212: x1 == 4');
X    x1 *= 3;
X    verify(x1 == 12, '213: x1 == 12');
X    x1 /= 4;
X    verify(x1 == 3, '214: x1 == 3');
X    x1 = x2 = x3;
X    verify(x2 == 14, '215: x2 == 14');
X    verify(x1 == 14, '216: x1 == 14');
X    print '217: Ending test_variables';
X}
X
X
X/*
X * Test logical AND and OR operators and short-circuit evaluation.
X */
Xdefine test_logicals()
X{
X    local    x;
X
X    print '300: Beginning test_logicals';
X
X    if (2 && 3)
X        print '301: if (2 && 3)';
X    else
X        print '**** if (2 && 3)';
X
X    if (2 && 0)
X        print '**** if (2 && 0)';
X    else
X        print '302: if (2 && 0)';
X
X    if (0 && 2)
X        print '**** if (0 && 2)';
X    else
X        print '303: if (0 && 2)';
X
X    if (0 && 0)
X        print '**** if (0 && 0)';
X    else
X        print '304: if (0 && 0)';
X
X    if (2 || 0)
X        print '305: if (2 || 0)';
X    else
X        print '**** if (2 || 0)';
X
X    if (0 || 2)
X        print '306: if (0 || 2)';
X    else
X        print '**** if (0 || 2)';
X
X    if (0 || 0)
X        print '**** if (0 || 0)';
X    else
X        print '307: if (0 || 0)';
X
X    x = 2 || 3; verify(x == 2, '308: (2 || 3) == 2');
X    x = 2 || 0; verify(x == 2, '309: (2 || 0) == 2');
X    x = 0 || 3; verify(x == 3, '310: (0 || 3) == 3');
X    x = 0 || 0; verify(x == 0, '311: (0 || 0) == 0');
X    x = 2 && 3; verify(x == 3, '312: (2 && 3) == 3');
X    x = 2 && 0; verify(x == 0, '313: (2 && 0) == 0');
X    x = 0 && 3; verify(x == 0, '314: (0 && 3) == 0');
X    x = 2 || error('2 || error()');
X    x = 0 && error('0 && error()');
X    print '315: Ending test_logicals';
X}
X
X
X/*
X * Test simple arithmetic operations and expressions.
X */
Xdefine test_arithmetic()
X{
X    print '400: Beginning test_arithmetic';
X    verify(3+4==7, '401: 3 + 4 == 7');
X    verify(4-1==3, '402: 4 - 1 == 3');
X    verify(2*3==6, '403: 2 * 3 == 6');
X    verify(8/4==2, '404: 8 / 4 == 2');
X    verify(2^3==8, '405: 2 ^ 3 == 8');
X    verify(9-4-2==3, '406: 9-4-2 == 3');
X    verify(9-4+2==7, '407: 9-4+2 == 6');
X    verify(-5+2==-3,  '408: -5+2 == -3');
X    verify(2*3+1==7, '409: 2*3+1 == 7');
X    verify(1+2*3==7, '410: 1+2*3 == 7');
X    verify((1+2)*3==9, '411: (1+2)*3 == 9');
X    verify(2*(3+1)==8, '412: 2*(3+1) == 8');
X    verify(9-(2+3)==4, '413: 9-(2+3) == 4');
X    verify(9+(2-3)==8, '414: 9+(2-3) == 8');
X    verify((2+3)*(4+5)==45, '415: (2+3)*(4+5) == 45');
X    verify(10/(2+3)==2, '416: 10/(2+3) == 2');
X    verify(12/3+4==8, '417: 12/3+4 == 8');
X    verify(6+12/3==10, '418: 6+12/3 == 10');
X    verify(2+3==1+4, '419: 2+3 == 1+4');
X    verify(-(2+3)==-5, '420: -(2+3) == -5');
X    verify(7&18==2,    '421: 7&18 == 2');
X    verify(3|17==19,   '422: 3|17 == 19');
X    verify(2&3|1==3,   '423: 2&3|1 == 3');
X    verify(2&(3|1)==2, '424: 2&(3|1) == 2');
X    verify(3<<4==48,   '425: 3<<4 == 48');
X    verify(5>>1==2,    '426: 5>>1 == 2');
X    verify(3<<-1==1,   '427: 3<<-1 == 1');
X    verify(5>>-2==20,  '428: 5>>-2 == 20');
X    verify(1<<2<<3==65536, '429: 1<<2<<3 == 65536');
X    verify((1<<2)<<3==32, '430: (1<<2)<<3 == 32');
X    verify(2^3^2==512, '431: 2^3^2 == 512');
X    verify((2^3)^2==64,'432: (2^3)^2 == 64');
X    print '433: Ending test_arithmetic';
X}
X
X
X/*
X * Test string constants and comparisons
X */
Xdefine test_strings()
X{
X    local x, y, z;
X
X    print '500: Beginning test_strings';
X    x = 'string';
X    y = "string";
X    z = x;
X    verify(z == "string", '501: z == "string"');
X    verify(z != "foo", '502: z != "foo"');
X    verify(z != 3, '503: z != 3');
X    verify('' == "", '504: \'\' == ""');
X    verify("a" == "a", '505: "a" == "a"');
X    verify("c" != "d", '506: "c" != "d"');
X    verify("" != "a", '507: "" != "a"');
X    verify("rs" < "rt", '508: "rs" < "rt"');
X    verify("rs" < "ss", '509: "rs < "ss"');
X    verify("rs" <= "rs", '510: "rs" <= "rs"');
X    verify("rs" <= "tu", '511: "rs" <= "tu"');
X    verify("rs" > "cd", '512: "rs" > "cd"');
X    verify("rs" >= "rs", '513: "rs" >= "rs"');
X    verify("rs" >= "cd", '514: "rs" >= "cd"');
X    verify("abc" > "ab", '515: "abc" > "ab"');
X    print '516: Ending test_strings';
X}
X
X
X/*
X * Do multiplication and division on three numbers in various ways
X * and verify the results agree.
X */
Xdefine muldivcheck(a, b, c, str)
X{
X    local    abc, acb, bac, bca, cab, cba;
X
X    abc = (a * b) * c;
X    acb = (a * c) * b;
X    bac = (b * a) * c;
X    bca = (b * c) * a;
X    cab = (c * a) * b;
X    cba = (c * b) * a;
X
X    if (abc != acb) print '**** abc != acb:', str;
X    if (acb != bac) print '**** acb != bac:', str;
X    if (bac != bca) print '**** bac != bca:', str;
X    if (bca != cab) print '**** bca != cab:', str;
X    if (cab != cba) print '**** cab != cba:', str;
X    if (abc/a != b*c) print '**** abc/a != bc:', str;
X    if (abc/b != a*c) print '**** abc/b != ac:', str;
X    if (abc/c != a*b) print '**** abc/c != ab:', str;
X    print str;
X}
X
X
X/*
X * Use the identity for squaring the sum of two squares to check
X * multiplication and squaring.
X */
Xdefine squarecheck(a, b, str)
X{
X    local    a2, b2, tab, apb, apb2, t;
X
X    a2 = a^2;
X    b2 = b^2;
X    tab = a * b * 2;
X    apb = a + b;
X    apb2 = apb^2;
X    if (a2 != a*a) print '**** a^2 != a*a:', str;
X    if (b2 != b*b) print '**** b^2 != b*b:', str;
X    if (apb2 != apb*apb) print '**** (a+b)^2 != (a+b)*(a+b):', str;
X    if (a2+tab+b2 != apb2) print '**** (a+b)^2 != a^2 + 2ab + b^2:', str;
X    if (a2/a != a) print '**** a^2/a != a:', str;
X    if (b2/b != b) print '**** b^2/b != b:', str;
X    if (apb2/apb != apb) print '**** (a+b)^2/(a+b) != a+b:', str;
X    if (a2*b2 != (a*b)^2) print '**** a^2*b^2 != (ab)^2:', str;
X    print str;
X}
X
X
X/*
X * Use the raising of numbers to large powers to check multiplication
X * and exponentiation.
X */
Xdefine powercheck(a, p1, p2, str)
X{
X    local    a1, a2, a3;
X
X    a1 = (a^p1)^p2;
X    a2 = (a^p2)^p1;
X    a3 = a^(p1*p2);
X    if (a1 != a2) print '**** (a^p1)^p2 != (a^p2)^p1:', str;
X    if (a1 != a3) print '**** (a^p1)^p2 != a^(p1*p2):', str;
X    print str;
X}
X
X
X/*
X * Test fraction reductions.
X * Arguments MUST be relatively prime.
X */
Xdefine fraccheck(a, b, c, str)
X{
X    local    ab, bc, ca, aoc, boc, aob;
X
X    ab = a * b;
X    bc = b * c;
X    ca = c * a;
X    aoc = ab / bc;
X    if (num(aoc) != a) print '**** num(aoc) != a:', str;
X    if (den(aoc) != c) print '**** den(aoc) != c:', str;
X    boc = ab / ca;
X    if (num(boc) != b) print '**** num(boc) != b:', str;
X    if (den(boc) != c) print '**** den(boc) != c:', str;
X    aob = ca / bc;
X    if (num(aob) != a) print '**** num(aob) != a:', str;
X    if (den(aob) != b) print '**** den(aob) != b:', str;
X    if (aob*boc != aoc) print '**** aob*boc != aoc;', str;
X    print str;
X}
X
X
X/*
X * Test multiplication and squaring algorithms.
X */
Xdefine algcheck(a, b, str)
X{
X    local    ss, ms, t1, t2, t3, t4, t5, t6, t7;
X    local    a1, a2, a3, a4, a5, a6, a7;
X    local    oldmul2, oldsq2;
X
X    oldmul2 = config("mul2", 2);
X    oldsq2 = config("sq2", 2);
X    a1 = a * b;
X    a2 = a * a;
X    a3 = b * b;
X    a4 = a^2;
X    a5 = b^2;
X    a6 = a2^2;
X    a7 = pmod(3,a-1,a);
X    for (ms = 2; ms < 20; ms++) {
X        for (ss = 2; ss < 20; ss++) {
X            config("mul2", ms);
X            config("sq2", ss);
X            t1 = a * b;
X            t2 = a * a;
X            t3 = b * b;
X            t4 = a^2;
X            t5 = b^2;
X            t6 = t2^2;
X            if (((ms + ss) % 37) == 4)
X                t7 = pmod(3,a-1,a);
X            if (t1 != a1) print '**** t1 != a1:', str;
X            if (t2 != a2) print '**** t2 != a2:', str;
X            if (t3 != a3) print '**** t3 != a3:', str;
X            if (t4 != a4) print '**** t4 != a4:', str;
X            if (t5 != a5) print '**** t5 != a5:', str;
X            if (t6 != a6) print '**** t6 != a6:', str;
X            if (t7 != a7) print '**** t7 != a7:', str;
X        }
X    }
X    config("mul2", oldmul2);
X    config("sq2", oldsq2);
X    print str;
X}
X
X
X/*
X * Test big numbers using some identities.
X */
Xdefine test_bignums()
X{
X    local    a, b, c, d;
X
X    print '600: Beginning test_bignums';
X    a = 64357824568234938591;
X    b = 12764632632458756817;
X    c = 43578234973856347982;
X    muldivcheck(a, b, c, '601: muldivcheck 1');
X    a = 3^100;
X    b = 5^97;
X    c = 7^88;
X    muldivcheck(a, b, c, '602: muldivcheck 2');
X    a = 2^160 - 1;
X    b = 2^161 - 1;
X    c = 2^162 - 1;
X    muldivcheck(a, b, c, '603: muldivcheck 3');
X    a = 3^35 / 5^35;
X    b = 7^35 / 11^35;
X    c = 13^35 / 17^35;
X    muldivcheck(a, b, c, '604: muldivcheck 4');
X    a = (10^97-1) / 9;
X    b = (10^53-1) / 9;
X    c = (10^37-1) / 9;
X    muldivcheck(a, b, c, '605: muldivcheck 5');
X    a = 17^50;
X    b = 19^47;
X    squarecheck(a, b, '606: squarecheck 1');
X    a = 2^111-1;
X    b = 2^17;
X    squarecheck(a, b, '607: squarecheck 2');
X    a = 23^43 / 29^43;
X    b = 31^42 / 37^29;
X    squarecheck(a, b, '608: squarecheck 3');
X    a = 4657892345743659834657238947854639;
X    b = 43784356784365893467659347867689;
X    squarecheck(a, b, '609: squarecheck 4');
X    a = (10^80-1) / 9;
X    b = (10^50-1) / 9;
X    squarecheck(a, b, '610: squarecheck 5');
X    a = 101^99;
X    b = -a;
X    squarecheck(a, b, '611: squarecheck 6');
X    a = (10^19-1) / 9;
X    verify(ptest(a, 20), '612: primetest R19');
X    a = (10^23-1) / 9;
X    verify(ptest(a, 20), '613: primetest R23');
X    a = 2^127 - 1;
X    verify(ptest(a, 1), '614: primetest M127');
X    a = 2^521 - 1;
X    verify(ptest(a, 1), '615: primetest M521');
X    powercheck(17, 127, 30, '616: powercheck 1');
X    powercheck(111, 899, 6, '617: powercheck 2');
X    powercheck(3, 87, 89, '618: powercheck 3');
X    fraccheck(3^200, 5^173, 7^138, '619: fraccheck 1');
X    fraccheck(11^100, 12^98, 13^121, '620: fraccheck 2');
X    fraccheck(101^270, 103^111, 105^200, '621: fraccheck 3');
X    a = 0xffff0000ffffffff00000000ffff0000000000000000ffff;
X    b = 0x555544440000000000000000000000000000000011112222333344440000;
X    c = 0x999911113333000011111111000022220000000000000000333300000000ffff;
X    d = 0x3333ffffffff0000000000000000ffffffffffffffff000000000000;
X    algcheck(a, a, '622: algcheck 1');
X    algcheck(a, b, '623: algcheck 2');
X    algcheck(a, c, '624: algcheck 3');
X    algcheck(a, d, '625: algcheck 4');
X    algcheck(b, b, '626: algcheck 5');
X    algcheck(b, c, '627: algcheck 6');
X    algcheck(b, d, '628: algcheck 7');
X    algcheck(c, c, '629: algcheck 8');
X    algcheck(c, d, '630: algcheck 9');
X    algcheck(d, d, '631: algcheck 10');
X    print '632: Ending test_bignums';
X}
X
X
X/*
X * Test many of the built-in functions.
X */
Xdefine test_functions()
X{
X    print '700: Beginning test_functions';
X    verify(abs(3) == 3,    '701: abs(3) == 3');
X    verify(abs(-4) == 4,   '702: abs(-4) == 4');
X    verify(avg(7) == 7,    '703: avg(7) == 7');
X    verify(avg(3,5) == 4,  '704: avg(3,5) == 4');
X    verify(cmp(2,3) == -1, '705: cmp(2,3) == -1');
X    verify(cmp(6,6) == 0,  '706: cmp(6,6) == 0');
X    verify(cmp(7,4) == 1,  '707: cmp(7,4) == 1');
X    verify(comb(9,9) == 1, '708: comb(9,9) == 1');
X    verify(comb(5,2) == 10,'709: comb(5,2) == 10');
X    verify(conj(4) == 4,   '710: conj(4) == 4');
X    verify(conj(2-3i) == 2+3i, '711: conj(2-3i) == 2+3i');
X    verify(den(17) == 1,   '712: den(17) == 1');
X    verify(den(3/7) == 7,  '713: den(3/7) == 7');
X    verify(den(-2/3) == 3, '714: den(-2/3) == 3');
X    verify(digits(0) == 1, '715: digits(0) == 1');
X    verify(digits(9) == 1, '716: digits(9) == 1');
X    verify(digits(10) == 2,'717: digits(10) == 2');
X    verify(digits(-691) == 3, '718: digits(-691) == 3');
X    verify(eval('2+3') == 5, "719: eval('2+3') == 5");
X    verify(fcnt(11,3) == 0,'720: fcnt(11,3) == 0');
X    verify(fcnt(18,3) == 2,'721: fcnt(18,3) == 2');
X    verify(fib(0) == 0,    '722: fib(0) == 0');
X    verify(fib(1) == 1,    '723: fib(1) == 1');
X    verify(fib(9) == 34,   '724: fib(9) == 34');
X    verify(frem(12,5) == 12, '725: frem(12,5) == 12');
X    verify(frem(45,3) == 5, '726: frem(45,3) == 5');
X    verify(fact(0) == 1,   '727: fact(0) == 1');
X    verify(fact(1) == 1,   '728: fact(1) == 1');
X    verify(fact(5) == 120, '729: fact(5) == 120');
X    verify(frac(3) == 0,   '730: frac(3) == 0');
X    verify(frac(2/3) == 2/3, '731: frac(2/3) == 2/3');
X    verify(frac(17/3) == 2/3, '732: frac(17/3) == 2/3');
X    verify(gcd(0,3) == 3,  '733: gcd(0,3) == 3');
X    verify(gcd(1,12) == 1, '734: gcd(1,12) == 1');
X    verify(gcd(11,7) == 1, '735: gcd(11,7) == 1');
X    verify(gcd(20,65) == 5, '736: gcd(20,65) == 5');
X    verify(gcdrem(20,3) == 20, '737: gcdrem(20,3) == 20');
X    verify(gcdrem(100,6) == 25, '738: gcdrem(100,6) == 25');
X    verify(highbit(1) == 0, '739: highbit(1) == 0');
X    verify(highbit(15) == 3, '740: highbit(15) == 3');
X    verify(hypot(3,4) == 5, '741: hypot(3,4) == 5');
X    verify(ilog(90,3) == 4, '742: ilog(90,3) == 4');
X    verify(ilog10(123) == 2, '743: ilog10(123) == 2');
X    verify(ilog2(17) == 4, '744: ilog2(17) == 4');
X    verify(im(3) == 0,     '745: im(3) == 0');
X    verify(im(2+3i) == 3,  '746: im(2+3i) == 3');
X    verify(int(5) == 5,    '757: int(5) == 5');
X    verify(int(19/3) == 6, '758: int(19/3) == 6');
X    verify(inverse(3/2) == 2/3, '759: inverse(3/2) == 2/3');
X    verify(iroot(18,2) == 4, '760: iroot(18,2) == 4');
X    verify(iroot(100,3) == 4, '761: iroot(100,3) == 4');
X    verify(iseven(10) == 1, '762: iseven(10) == 1');
X    verify(iseven(13) == 0, '763: iseven(13) == 0');
X    verify(iseven('a') == 0, "764: iseven('a') == 0");
X    verify(isint(7) == 1,  '765: isint(7) == 1');
X    verify(isint(19/2) == 0, '766: isint(19/2) == 0');
X    verify(isint('a') == 0, "767: isint('a') == 0");
X    verify(islist(3) == 0, '768: islist(3) == 0');
X    verify(islist(list(2,3)) == 1, '769: islist(list(2,3)) == 1');
X    verify(ismat(3) == 0, '770: ismat(3) == 0');
X    verify(ismult(7,3) == 0, '771: ismult(7,3) == 0');
X    verify(ismult(15,5) == 1, '772: ismult(15,5) == 1');
X    verify(isnull(3) == 0, '773: isnull(3) == 0');
X    verify(isnull(null()) == 1, '774: isnull(null()) == 1');
X    verify(isnum(2/3) == 1, '775: isnum(2/3) == 1');
X    verify(isnum('xx') == 0, "776: isnum('xx') == 0");
X    verify(isobj(3) == 0, '777: isobj(3) == 0');
X    verify(isodd(7) == 1, '778: isodd(7) == 1');
X    verify(isodd(8) == 0, '779: isodd(8) == 0');
X    verify(isodd('x') == 0, "780: isodd('a') == 0");
X    verify(isqrt(27) == 5, '781: isqrt(27) == 5');
X    verify(isreal(3) == 1, '782: isreal(3) == 1');
X    verify(isreal('x') == 0, "783: isreal('x') == 0");
X    verify(isreal(2+3i) == 0, '784: isreal(2+3i) == 0');
X    verify(isstr(5) == 0,  '785: isstr(5) == 0');
X    verify(isstr('foo') == 1, "786: isstr('foo') == 1");
X    verify(isrel(10,14) == 0, '787: isrel(10,14) == 0');
X    verify(isrel(15,22) == 1, '788: isrel(15,22) == 1');
X    verify(issimple(6) == 1, '789: issimple(6) == 1');
X    verify(issimple(3-2i) == 1, '790: issimple(3-2i) == 1');
X    verify(issimple(list(5)) == 0, '791: issimple(list(5)) == 0');
X    verify(issq(26) == 0, '792: issq(26) == 0');
X    verify(issq(9/4) == 1, '793: issq(9/4) == 1');
X    verify(istype(9,4) == 1, '795: istype(9,4) == 1');
X    verify(istype(3,'xx') == 0, "796: istype(3,'xx') == 0");
X    verify(jacobi(5,11) == 1, '797: jacobi(2,7) == 1');
X    verify(jacobi(6,13) == -1, '798: jacobi(6,13) == 0');
X    verify(lcm(3,4,5,6) == 60, '799: lcm(3,4,5,6) == 60');
X    verify(lcmfact(8) == 840, '800: lcmfact(8) == 840');
X    verify(lfactor(21,5) == 3, '801: lfactor(21,5) == 3');
X    verify(lfactor(97,20) == 1, '802: lfactor(97,20) == 1');
X    verify(lowbit(12) == 2, '803: lowbit(12) == 2');
X    verify(lowbit(17) == 0, '804: lowbit(17) == 0');
X    verify(ltol(1) == 0, '805: ltol(1) == 0');
X    verify(max(3,-9,7,4) == 7, '806: max(3,-9,7,4) == 7');
X    verify(meq(13,33,10) == 1, '807: meq(13,33,10) == 1');
X    verify(meq(7,19,11) == 0, '808: meq(7,19,11) == 0');
X    verify(min(9,5,12) == 5, '809: min(9,5,12) == 5');
X    verify(minv(13,97) == 15, '810: minv(13,97) == 15');
X    verify(mne(16,37,10) == 1, '811: mne(16,37,10) == 1');
X    verify(mne(46,79,11) == 0, '812: mne(46,79,11) == 0');
X    verify(norm(4) == 16,   '813: norm(4) == 16');
X    verify(norm(2-3i) == 13, '814: norm(2-3i) == 13');
X    verify(num(7) == 7,     '815: num(7) == 7');
X    verify(num(11/4) == 11, '816: num(11/4) == 11');
X    verify(num(-9/5) == -9, '817: num(-9/5) == -9');
X    verify(char(ord('a')+2) == 'c', "818: char(ord('a')+2) == 'c'");
X    verify(perm(7,3) == 210, '819: perm(7,3) == 210');
X    verify(pfact(10) == 210, '820: pfact(10) == 210');
X    verify(places(3/7) == -1, '821: places(3/7) == -1');
X    verify(places(.347) == 3, '822: places(.347) == 3');
X    verify(places(17) == 0, '823: places(17) == 0');
X    verify(pmod(3,36,37) == 1, '824: pmod(3,36,37) == 1');
X    verify(poly(2,3,5,2) == 19, '825; poly(2,3,5,2) == 19');
X    verify(ptest(101,10) == 1, '826: ptest(101,10) == 1');
X    verify(ptest(221,30) == 0, '827: ptest(221,30) == 0');
X    verify(re(9) == 9,       '828: re(9) == 9');
X    verify(re(-7+3i) == -7,  '829: re(-7+3i) == -7');
X    verify(scale(3,4) == 48, '830: scale(3,4) == 48');
X    verify(sgn(-4) == -1,    '831: sgn(-4) == -1');
X    verify(sgn(0) == 0,      '832: sgn(0) == 0');
X    verify(sgn(3) == 1,      '833: sgn(3) == 1');
X    verify(size(7) == 1,     '834: size(7) == 1');
X    verify(sqrt(121) == 11,  '835: sqrt(121) == 11');
X    verify(ssq(2,3,4) == 29, '836: ssq(2,3,4) == 29');
X    verify(str(45) == '45',  "837; str(45) == '45'");
X    verify(strcat('a','bc','def')=='abcdef',"838; strcat('a','bc','def')=='abcdef'");
X    verify(strlen('') == 0,  "839: strlen('') == 0");
X    verify(strlen('abcd') == 4, "840: strlen('abcd') == 4");
X    verify(substr('abcd',2,1) == 'b', "841: substr('abcd',2,1) == 'b'");
X    verify(substr('abcd',3,4) == 'cd', "842: substr('abcd',3,4) == 'cd'");
X    verify(substr('abcd',1,3) == 'abc', "843: substr('abcd',1,3) == 'abc'");
X    verify(xor(17,17) == 0,  '844: xor(17,17) == 0');
X    verify(xor(12,5) == 9,   '845: xor(12,5) == 9');
X    verify(mmin(3,7) == 3, '846: mmin(3,7) == 3');
X    verify(mmin(4,7) == -3, '847: mmin(4,7) == -3');
X    verify(digit(123,2) == 1, '848: digit(123,2) == 1');
X    print '849: Ending test_functions';
X}
X
X
Xprint '001: Beginning regression tests';
Xprint '002: Within each section, output should be numbered sequentially';
Xprint;
Xreturn test_booleans();
Xprint;
Xreturn test_variables();
Xprint;
Xreturn test_logicals();
Xprint;
Xreturn test_arithmetic();
Xprint;
Xreturn test_strings();
Xprint;
Xreturn test_bignums();
Xprint;
Xreturn test_functions();
END_OF_FILE
if test 19555 -ne `wc -c <'lib/regress.cal'`; then
    echo shar: \"'lib/regress.cal'\" unpacked with wrong size!
fi
# end of 'lib/regress.cal'
fi
echo shar: End of archive 8 \(of 21\).
cp /dev/null ark8isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 21 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0