* doc/Tcl_Main.3:

        * generic/tclMain.c:  Substantial rewrite and expanded documentation
        of Tcl_Main to correct a number of bugs and flaws:

                * Interactive Tcl_Main can now enter a main loop, exit
                  that loop and continue interactive operations.  The loop
                  may even exit in the midst of interactive command typing
                  without loss of the partial command.  [Bugs 486453, 474131]
                * Tcl_Main now gracefully handles deletion of its master
                  interpreter.
                * Interactive Tcl_Main can now operate with non-blocking stdin
                * Interactive Tcl_Main can now detect EOF on stdin even in
                  mid-command.  [Bug 491341]
                * Added VFS-aware internal routines for managing the
                  startup script selection.
                * Tcl variable 'tcl_interactive' is now linked to C variable
                  'tty' so that one can disable/enable interactive prompts
                  at the script level when there is no startup script.  This
                  is meant for use by the test suite.
                * Consistent use of the Tcl libraries standard channels as
                  returned by Tcl_GetStdChannel(); as opposed to the channels
                  named 'stdin', 'stdout', and 'stderr' in the master interp,
                  which can be different or unavailable.
                * Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the
                  master interpreter returns, assuring Tcl_Main does not return.                * Documented Tcl_Main's absence from public stub table
                * Documented that Tcl_Main does not return.
                * Documented Tcl variables set by Tcl_Main.
                * All prompts are done from a single procedure, Prompt.
                * Use of Tcl_Obj-enabled interfaces everywhere.

        * generic/tclInt.decls (TclGetStartupScriptPath,
          TclSetStartupScriptPath): New internal VFS-aware routines for
        managing the startup script of Tcl_Main.
        * generic/tclIntDecls.h:
        * generic/tclStubInit.c: make genstubs

        * generic/tclTest.c (TestsetmainloopCmd,TestexitmainloopCmd,
          Tcltest_Init,TestinterpdeleteCmd):
        * tests/main.test (new):  Added new file to test suite that
        thoroughly tests generic/tclMain.c; added some new test commands
        for testing Tcl_SetMainLoop().

1 files changed, 143 insertions, 7 deletions

diff --git a/generic/tclTest.c b/generic/tclTest.c
index 029d0b9..2b977f2 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.34 2001/11/23 01:29:07 das Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.35 2002/01/05 22:55:52 dgp Exp $
  */
 
 #define TCL_TEST
@@ -107,6 +107,12 @@ typedef struct TclEncoding {
 static int freeCount;
 
 /*
+ * Boolean flag used by the "testsetmainloop" and "testexitmainloop"
+ * commands.
+ */
+static int exitMainLoop = 0;
+
+/*
  * Forward declarations for procedures defined later in this file:
  */
 
@@ -239,6 +245,10 @@ static int		TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Value *resultPtr));
 static int		TestmainthreadCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
 static Tcl_Channel	PretendTclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *filename, char *modeString, int permissions));
 static Tcl_Channel	TestOpenFileChannelProc1 _ANSI_ARGS_((Tcl_Interp *interp,
@@ -408,7 +418,15 @@ Tcltest_Init(interp)
     Tcl_Interp *interp;		/* Interpreter for application. */
 {
     Tcl_ValueType t3ArgTypes[2];
-	
+
+    Tcl_Obj *listPtr;
+    Tcl_Obj **objv;
+    int objc, index;
+    static char *specialOptions[] = {
+	"-appinitprocerror", "-appinitprocdeleteinterp",
+	"-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL
+    };
+
     if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) {
         return TCL_ERROR;
     }
@@ -532,6 +550,10 @@ Tcltest_Init(interp)
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
+	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
+	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     t3ArgTypes[0] = TCL_EITHER;
     t3ArgTypes[1] = TCL_EITHER;
     Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
@@ -544,6 +566,42 @@ Tcltest_Init(interp)
 #endif
 
     /*
+     * Check for special options used in ../tests/main.test
+     */
+
+    listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
+    if (listPtr != NULL) {
+        if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+	    return TCL_ERROR;
+        }
+        if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
+		TCL_EXACT, &index) == TCL_OK)) {
+	    switch (index) {
+	        case 0: {
+		    return TCL_ERROR;
+	        }
+	        case 1: {
+		    Tcl_DeleteInterp(interp);
+		    return TCL_ERROR;
+	        }
+	        case 2: {
+		    int mode;
+		    Tcl_UnregisterChannel(interp, 
+			    Tcl_GetChannel(interp, "stderr", &mode));
+		    return TCL_ERROR;
+	        }
+	        case 3: {
+		    if (objc-1) {
+		        Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL,
+			       objv[1], TCL_GLOBAL_ONLY);
+		    }
+		    return TCL_ERROR;
+	        }
+	    }
+        }
+    }
+	
+    /*
      * And finally add any platform specific test commands.
      */
     
@@ -1934,11 +1992,6 @@ TestinterpdeleteCmd(dummy, interp, argc, argv)
                 " path\"", (char *) NULL);
         return TCL_ERROR;
     }
-    if (argv[1][0] == '\0') {
-        Tcl_AppendResult(interp, "cannot delete current interpreter",
-                (char *) NULL);
-        return TCL_ERROR;
-    }
     slaveToDelete = Tcl_GetSlave(interp, argv[1]);
     if (slaveToDelete == (Tcl_Interp *) NULL) {
         return TCL_ERROR;
@@ -4164,6 +4217,89 @@ TestmainthreadCmd (dummy, interp, argc, argv)
       return TCL_ERROR;
   }
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MainLoop --
+ *
+ *	A main loop set by TestsetmainloopCmd below.
+ *
+ * Results:
+ * 	None.
+ *
+ * Side effects:
+ *	Event handlers could do anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MainLoop()
+{
+    while (!exitMainLoop) {
+	Tcl_DoOneEvent(0);
+    }
+    fprintf(stdout,"Exit MainLoop\n");
+    fflush(stdout);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetmainloopCmd  --
+ *
+ *	Implements the "testsetmainloop" cmd that is used to test the
+ *	'Tcl_SetMainLoop' API.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestsetmainloopCmd (dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+  exitMainLoop = 0;
+  Tcl_SetMainLoop(MainLoop);
+  return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexitmainloopCmd  --
+ *
+ *	Implements the "testexitmainloop" cmd that is used to test the
+ *	'Tcl_SetMainLoop' API.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexitmainloopCmd (dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+  exitMainLoop = 1;
+  return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------