Return to tclTest.c CVS log

Up to [Research Unix] / researchv10dc / cmd / worm / scsi / tcl

Annotation of researchv10dc/cmd/worm/scsi/tcl/tclTest.c, revision 1.1.1.1

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

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