home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 0 / 0987 / tclTest.c < prev   
Encoding:
C/C++ Source or Header  |  1990-12-28  |  3.6 KB  |  186 lines
  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.6 90/02/09 08:34:14 ouster Exp $ SPRITE (Berkeley)";
  19. #endif /* not lint */
  20.  
  21. #include <stdio.h>
  22. #ifdef BSD
  23. #include <sys/time.h>
  24. #endif
  25. #include "tcl.h"
  26.  
  27. Tcl_Interp *interp;
  28.  
  29. int
  30. cmdEcho(clientData, interp, argc, argv)
  31.     char *clientData;
  32.     Tcl_Interp *interp;
  33.     int argc;
  34.     char **argv;
  35. {
  36.     int i;
  37.  
  38.     for (i = 1; ; i++) {
  39.     if (argv[i] == NULL) {
  40.         if (i != argc) {
  41.         echoError:
  42.         sprintf(interp->result,
  43.             "argument list wasn't properly NULL-terminated in \"%s\" command",
  44.             argv[0]);
  45.         }
  46.         break;
  47.     }
  48.     if (i >= argc) {
  49.         goto echoError;
  50.     }
  51.     fputs(argv[i], stdout);
  52.     if (i < (argc-1)) {
  53.         printf(" ");
  54.     }
  55.     }
  56.     printf("\n");
  57.     return TCL_OK;
  58. }
  59.  
  60. void
  61. deleteProc(clientData)
  62.     char *clientData;
  63. {
  64.     printf("Deleting command with clientData \"%s\".\n", clientData);
  65. }
  66.  
  67. int
  68. cmdCreate(clientData, interp, argc, argv)
  69.     ClientData clientData;        /* Not used. */
  70.     Tcl_Interp *interp;
  71.     int argc;
  72.     int *argv;
  73. {
  74.     int count;
  75.     if (argc != 2) {
  76.     sprintf(interp->result, "wrong # args:  should be \"%.50s count\"",
  77.         argv[0]);
  78.     return TCL_ERROR;
  79.     }
  80.     count = atoi(argv[1]);
  81.     for (; count > 0; count--) {
  82.     Tcl_DeleteInterp(Tcl_CreateInterp());
  83.     }
  84.     return TCL_OK;
  85. }
  86.  
  87. int
  88. cmdSleep(clientData, interp, argc, argv)
  89.     ClientData clientData;        /* Not used. */
  90.     Tcl_Interp *interp;
  91.     int argc;
  92.     int *argv;
  93. {
  94.     int count;
  95.     if (argc != 2) {
  96.     sprintf(interp->result, "wrong # args:  should be \"%.50s seconds\"",
  97.         argv[0]);
  98.     return TCL_ERROR;
  99.     }
  100.     count = atoi(argv[1]);
  101.     sleep(count);
  102.     return TCL_OK;
  103. }
  104.  
  105. main()
  106. {
  107.     char cmd[1000], *p;
  108.     register char *p2;
  109.     int c, i, result;
  110.  
  111.     interp = Tcl_CreateInterp();
  112.     Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
  113.         deleteProc);
  114.     Tcl_CreateCommand(interp, "create", cmdCreate, (ClientData) "create",
  115.         deleteProc);
  116.     Tcl_CreateCommand(interp, "sleep", cmdSleep, (ClientData) "sleep",
  117.         deleteProc);
  118.     stream_init(interp);
  119.  
  120.     while (1) {
  121.     clearerr(stdin);
  122.     fputs("% ", stdout);
  123.     fflush(stdout);
  124.     p = cmd;
  125.     while (1) {
  126.         c = getchar();
  127.         if (c == EOF) {
  128.         if (p == cmd) {
  129.             exit(0);
  130.         }
  131.         goto gotCommand;
  132.         }
  133.         if (c == '\n') {
  134.         register char *p2;
  135.         int parens, brackets, numBytes;
  136.  
  137.         for (p2 = cmd, parens = 0, brackets = 0; p2 != p; p2++) {
  138.             switch (*p2) {
  139.             case '\\':
  140.                 Tcl_Backslash(p2, &numBytes);
  141.                 p2 += numBytes-1;
  142.                 break;
  143.             case '{':
  144.                 parens++;
  145.                 break;
  146.             case '}':
  147.                 parens--;
  148.                 break;
  149.             case '[':
  150.                 brackets++;
  151.                 break;
  152.             case ']':
  153.                 brackets--;
  154.                 break;
  155.             }
  156.         }
  157.         if ((parens <= 0) && (brackets <= 0)) {
  158.             goto gotCommand;
  159.         }
  160.         }
  161.         *p = c;
  162.         p++;
  163.     }
  164.     gotCommand:
  165.     *p = 0;
  166.  
  167.     result = Tcl_Eval(interp, cmd, 0, &p);
  168.     if (result == TCL_OK) {
  169.         if (*interp->result != 0) {
  170.         printf("%s\n", interp->result);
  171.         }
  172.     } else {
  173.         if (result == TCL_ERROR) {
  174.         printf("Error");
  175.         } else {
  176.         printf("Error %d", result);
  177.         }
  178.         if (*interp->result != 0) {
  179.         printf(": %s\n", interp->result);
  180.         } else {
  181.         printf("\n");
  182.         }
  183.     }
  184.     }
  185. }
  186.