Return to tcltest.c CVS log

Up to [Micropolis - Activity] / micropolis / src / tcl

Annotation of micropolis/src/tcl/tcltest.c, revision 1.1.1.1

1.1       root        1: /* 
                      2:  * tclTest.c --
                      3:  *
                      4:  *     Test driver for TCL.
                      5:  *
                      6:  * Copyright 1987-1991 Regents of the University of California
                      7:  * All rights reserved.
                      8:  *
                      9:  * Permission to use, copy, modify, and distribute this
                     10:  * software and its documentation for any purpose and without
                     11:  * fee is hereby granted, provided that the above copyright
                     12:  * notice appears in all copies.  The University of California
                     13:  * makes no representations about the suitability of this
                     14:  * software for any purpose.  It is provided "as is" without
                     15:  * express or implied warranty.
                     16:  */
                     17: 
                     18: #ifndef lint
                     19: static char rcsid[] = "$Header: /user6/ouster/tcl/tclTest/RCS/tclTest.c,v 1.21 92/01/19 14:15:27 ouster Exp $ SPRITE (Berkeley)";
                     20: #endif
                     21: 
                     22: #include <stdio.h>
                     23: #include <errno.h>
                     24: #include <string.h>
                     25: #include "tcl.h"
                     26: 
                     27: extern int exit();
                     28: extern int Tcl_DumpActiveMemory();
                     29: 
                     30: Tcl_Interp *interp;
                     31: Tcl_CmdBuf buffer;
                     32: char dumpFile[100];
                     33: int quitFlag = 0;
                     34: 
                     35: char *initCmd =
                     36:     "if [file exists [info library]/init.tcl] {source [info library]/init.tcl}";
                     37: 
                     38:        /* ARGSUSED */
                     39: int
                     40: cmdCheckmem(clientData, interp, argc, argv)
                     41:     ClientData clientData;
                     42:     Tcl_Interp *interp;
                     43:     int argc;
                     44:     char *argv[];
                     45: {
                     46:     if (argc != 2) {
                     47:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                     48:                " fileName\"", (char *) NULL);
                     49:        return TCL_ERROR;
                     50:     }
                     51:     strcpy(dumpFile, argv[1]);
                     52:     quitFlag = 1;
                     53:     return TCL_OK;
                     54: }
                     55: 
                     56:        /* ARGSUSED */
                     57: int
                     58: cmdEcho(clientData, interp, argc, argv)
                     59:     ClientData clientData;
                     60:     Tcl_Interp *interp;
                     61:     int argc;
                     62:     char *argv[];
                     63: {
                     64:     int i;
                     65: 
                     66:     for (i = 1; ; i++) {
                     67:        if (argv[i] == NULL) {
                     68:            if (i != argc) {
                     69:                echoError:
                     70:                sprintf(interp->result,
                     71:                    "argument list wasn't properly NULL-terminated in \"%s\" command",
                     72:                    argv[0]);
                     73:            }
                     74:            break;
                     75:        }
                     76:        if (i >= argc) {
                     77:            goto echoError;
                     78:        }
                     79:        fputs(argv[i], stdout);
                     80:        if (i < (argc-1)) {
                     81:            printf(" ");
                     82:        }
                     83:     }
                     84:     printf("\n");
                     85:     return TCL_OK;
                     86: }
                     87: 
                     88: int
                     89: main()
                     90: {
                     91:     char line[1000], *cmd;
                     92:     int result, gotPartial;
                     93: 
                     94:     interp = Tcl_CreateInterp();
                     95: #ifdef TCL_MEM_DEBUG
                     96:     Tcl_InitMemory(interp);
                     97: #endif
                     98:     Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
                     99:            (Tcl_CmdDeleteProc *) NULL);
                    100:     Tcl_CreateCommand(interp, "checkmem", cmdCheckmem, (ClientData) 0,
                    101:            (Tcl_CmdDeleteProc *) NULL);
                    102:     buffer = Tcl_CreateCmdBuf();
                    103: #ifndef TCL_GENERIC_ONLY
                    104:     result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
                    105:     if (result != TCL_OK) {
                    106:        printf("%s\n", interp->result);
                    107:        exit(1);
                    108:     }
                    109: #endif
                    110: 
                    111:     gotPartial = 0;
                    112:     while (1) {
                    113:        clearerr(stdin);
                    114:        if (!gotPartial) {
                    115:            fputs("% ", stdout);
                    116:            fflush(stdout);
                    117:        }
                    118:        if (fgets(line, 1000, stdin) == NULL) {
                    119:            if (!gotPartial) {
                    120:                exit(0);
                    121:            }
                    122:            line[0] = 0;
                    123:        }
                    124:        cmd = Tcl_AssembleCmd(buffer, line);
                    125:        if (cmd == NULL) {
                    126:            gotPartial = 1;
                    127:            continue;
                    128:        }
                    129: 
                    130:        gotPartial = 0;
                    131:        result = Tcl_RecordAndEval(interp, cmd, 0);
                    132:        if (result == TCL_OK) {
                    133:            if (*interp->result != 0) {
                    134:                printf("%s\n", interp->result);
                    135:            }
                    136:            if (quitFlag) {
                    137:                Tcl_DeleteInterp(interp);
                    138:                Tcl_DeleteCmdBuf(buffer);
                    139: #ifdef TCL_MEM_DEBUG
                    140:                Tcl_DumpActiveMemory(dumpFile);
                    141: #endif
                    142:                exit(0);
                    143:            }
                    144:        } else {
                    145:            if (result == TCL_ERROR) {
                    146:                printf("Error");
                    147:            } else {
                    148:                printf("Error %d", result);
                    149:            }
                    150:            if (*interp->result != 0) {
                    151:                printf(": %s\n", interp->result);
                    152:            } else {
                    153:                printf("\n");
                    154:            }
                    155:        }
                    156:     }
                    157: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.