home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tcl / dist / tclTest.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-01-19  |  3.3 KB  |  158 lines
  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. }
  158.