


/*
 * tclTest.c --
 * 
 * Test driver for TCL.
 * 
 * Copyright 1987-1991 Regents of the University of California All rights
 * reserved.
 * 
 * Permission to use, copy, modify, and distribute this software and its
 * documentation for any purpose and without fee is hereby granted, provided
 * that the above copyright notice appears in all copies.  The University of
 * California makes no representations about the suitability of this software
 * for any purpose.  It is provided "as is" without express or implied
 * warranty.
 */

#ifndef lint
static char     rcsid[] = "$Header: /home/argon3/lab/staff/cxh/RCS/tclsqlTest.c,v 1.2 1992/09/29 21:20:13 cxh Exp cxh $ SPRITE (Berkeley)";
#endif

#include <stdio.h>
#include <errno.h>
#include <string.h>
#include "tcl.h"
#define TCL_SQL

void            exit();
extern int      Tcl_DumpActiveMemory();

Tcl_Interp     *interp;
Tcl_CmdBuf      buffer;
char            dumpFile[100];
/*
 * ###34 [lint] quitFlag multiply declared tclsqlTest.c(34) ::
 * tclTest.c(33)%%%
 */
int             quitFlag = 0;

/*
 * ###36 [lint] initCmd multiply declared tclsqlTest.c(36) ::
 * tclTest.c(35)%%%
 */
char           *initCmd =
"if [file exists [info library]/init.tcl] {source [info library]/init.tcl}";

/* ARGSUSED */
int
cmdCheckmem(clientData, interp, argc, argv)
     ClientData      clientData;
     Tcl_Interp     *interp;
     int             argc;
     char           *argv[];
     /*
      * ###46 [lint] cmdCheckmem multiply declared tclsqlTest.c(46) ::
      * tclTest.c(45)%%%
      */
{
  if (argc != 2) {
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		     " fileName\"", (char *) NULL);
    return TCL_ERROR;
  }
  strcpy(dumpFile, argv[1]);
  quitFlag = 1;
  return TCL_OK;
}

/* ARGSUSED */
int
cmdEcho(clientData, interp, argc, argv)
     ClientData      clientData;
     Tcl_Interp     *interp;
     int             argc;
     char           *argv[];
     /*
      * ###64 [lint] cmdEcho multiply declared tclsqlTest.c(64) ::
      * tclTest.c(63)%%%
      */
{
  int             i;

  for (i = 1;; i++) {
    if (argv[i] == NULL) {
      if (i != argc) {
      echoError:
	sprintf(interp->result,
	  "argument list wasn't properly NULL-terminated in \"%s\" command",
		argv[0]);
      }
      break;
    }
    if (i >= argc) {
      goto echoError;
    }
    fputs(argv[i], stdout);
    if (i < (argc - 1)) {
      printf(" ");
    }
  }
  printf("\n");
  return TCL_OK;
}

int
main()
     /*
      * ###91 [lint] main multiply declared tclsqlTest.c(91) ::
      * tclTest.c(90)%%%
      */
{
  char            line[1000], *cmd;
  int             result, gotPartial;

  interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
  Tcl_InitMemory(interp);
#endif

#ifdef TCL_SQL
  /* Initialize the SQL commands */
  SQLinit(interp);
#endif /* TCL_SQL */

  /* ###105 [lint] warning possible pointer alignment problem%%% */
  Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
		    (Tcl_CmdDeleteProc *) NULL);
  Tcl_CreateCommand(interp, "checkmem", cmdCheckmem, (ClientData) 0,
		    (Tcl_CmdDeleteProc *) NULL);
  buffer = Tcl_CreateCmdBuf();
#ifndef TCL_GENERIC_ONLY
  result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
  if (result != TCL_OK) {
    printf("%s\n", interp->result);
#ifdef TCL_SQL
    sql_cleanup(interp);		/* Cleanup any SQL stuff. */
#endif /* TCL_SQL */
    exit(1);
  }
#endif

  gotPartial = 0;
  while (1) {
    clearerr(stdin);
    if (!gotPartial) {
      fputs("% ", stdout);
      fflush(stdout);
    }
    if (fgets(line, 1000, stdin) == NULL) {
      if (!gotPartial) {
#ifdef TCL_SQL
	sql_cleanup(interp);		/* Cleanup any SQL stuff. */
#endif /* TCL_SQL */
	exit(0);
      }
      line[0] = 0;
    }
    cmd = Tcl_AssembleCmd(buffer, line);
    if (cmd == NULL) {
      gotPartial = 1;
      continue;
    }

    gotPartial = 0;
    result = Tcl_RecordAndEval(interp, cmd, 0);
    if (result == TCL_OK) {
      if (*interp->result != 0) {
	printf("%s\n", interp->result);
      }
      if (quitFlag) {
	Tcl_DeleteInterp(interp);
	Tcl_DeleteCmdBuf(buffer);
#ifdef TCL_MEM_DEBUG
	Tcl_DumpActiveMemory(dumpFile);
#endif
#ifdef TCL_SQL
	sql_cleanup(interp);		/* Cleanup any SQL stuff. */
#endif /* TCL_SQL */
	exit(0);
      }
    }
    else {
      if (result == TCL_ERROR) {
	printf("Error");
      }
      else {
	printf("Error %d", result);
      }
      if (*interp->result != 0) {
	printf(": %s\n", interp->result);
      }
      else {
	printf("\n");
      }
    }
  }
}
