Return to tclTest.c CVS log

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

Annotation of researchv10no/cmd/worm/scsi/tcl/tclTest.c, revision 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.