| 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 | } |