* 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().

8 files changed, 1609 insertions, 200 deletions

diff --git a/ChangeLog b/ChangeLog
index 7b41720..8ec7a98 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,48 @@
+2002-01-05  Don Porter <dgp@users.sourceforge.net>
+
+	* 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().
+
 2002-01-04  Don Porter <dgp@users.sourceforge.net>
 
 	* generic/tclThreadJoin.c (TclRememberJoinableThread,TclJoinThread):
diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3
index 038eff9..d5bc108 100644
--- a/doc/Tcl_Main.3
+++ b/doc/Tcl_Main.3
@@ -6,7 +6,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: Tcl_Main.3,v 1.5 2001/12/10 15:50:47 dgp Exp $
+'\" RCS: @(#) $Id: Tcl_Main.3,v 1.6 2002/01/05 22:55:51 dgp Exp $
 '\" 
 .so man.macros
 .TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures"
@@ -49,20 +49,52 @@ nothing but invoke \fBTcl_Main\fR.
 \fBTcl_Main\fR then does all the work of creating and running a
 \fBtclsh\fR-like application.
 .PP
-When it is has finished its own initialization, but before
-it processes commands, \fBTcl_Main\fR calls the procedure given by
-the \fIappInitProc\fR argument.  This procedure provides a ``hook''
-for the application to perform its own initialization, such as defining
-application-specific commands.  The procedure must have an interface
-that matches the type \fBTcl_AppInitProc\fR:
+\fBTcl_Main\fR is not provided by the public interface of Tcl's
+stub library.  Programs that call \fBTcl_Main\fR must be linked
+against the standard Tcl library.  Extensions (stub-enabled or
+not) are not intended to call \fBTcl_Main\fR.
+.PP
+\fBTcl_Main\fR and therefore all applications based upon it, like
+\fBtclsh\fR, use \fBTcl_GetStdChannel\fR to initialize the standard
+channels to their default values. See \fBTcl_StandardChannels\fR for
+more information.
+.PP
+\fBTcl_Main\fR supports two modes of operation, depending on the
+values of \fIargc\fR and \fIargv\fR.  If \fIargv[1]\fR exists and
+does not begin with the character \fI-\fR, it is taken to be the
+name of a file containing a \fIstartup script\fR, which \fBTcl_Main\fR
+will attempt to evaluate.  Otherwise, \fBTcl_Main\fR will enter an
+interactive mode.
+.PP
+In either mode, \fBTcl_Main\fB will define in its master interpreter
+the Tcl variables \fIargc\fR, \fIargv\fR, \fIargv0\fR, and
+\fItcl_interactive\fR, as described in the documentation for \fBtclsh\fR.
+.PP
+When it has finished its own initialization, but before it processes
+commands, \fBTcl_Main\fR calls the procedure given by the
+\fIappInitProc\fR argument.  This procedure provides a ``hook'' for
+the application to perform its own initialization of the interpreter
+created by \fBTcl_Main\fR, such as defining application-specific
+commands.  The procedure must have an interface that matches the
+type \fBTcl_AppInitProc\fR:
 .CS
 typedef int Tcl_AppInitProc(Tcl_Interp *\fIinterp\fR);
 .CE
 
 \fIAppInitProc\fR is almost always a pointer to \fBTcl_AppInit\fR; for more
 details on this procedure, see the documentation for \fBTcl_AppInit\fR.
-When the \fIappInitProc\fR is finished, the startup script will be
-evaluated.  If none exists, then an interactive prompt is provided.
+.PP
+When the \fIappInitProc\fR is finished, \fBTcl_Main\fR enters one
+of its two modes.  If a startup script has been provided, \fBTcl_Main\fR
+attempts to evaluate it.  Otherwise interactive operations begin,
+with prompts and command evaluation results written to the standard
+output channel, and commands read from the standard input channel
+and then evaluated.  The prompts written to the standard output
+channel may be customized by defining the Tcl variables \fItcl_prompt1\fR
+and \fItcl_prompt2\fR as described in the documentation for \fBtclsh\fR.
+The prompts and command evaluation results are written to the standard
+output channel only if the Tcl variable \fItcl_interactive\fR in the
+master interpreter holds a non-zero integer value.
 .PP
 .VS 8.4
 \fBTcl_SetMainLoop\fR allows setting an event loop procedure to be run.
@@ -70,21 +102,28 @@ This allows, for example, Tk to be dynamically loaded and set its event
 loop.  The event loop will run following the startup script.  If you
 are in interactive mode, setting the main loop procedure will cause the
 prompt to become fileevent based and then the loop procedure is called.
+When the loop procedure returns in interactive mode, interactive operation
+will continue.
 The main loop procedure must have an interface that matches the type
 \fBTcl_MainLoopProc\fR:
 .CS
 typedef void Tcl_MainLoopProc(void);
 .CE
 .VE 8.4
-
 .PP
-\fBTcl_Main\fR and therefore all applications based upon it, like
-\fBtclsh\fR, use \fBTcl_GetStdChannel\fR to initialize the standard
-channels to their default values. See \fBTcl_StandardChannels\fR for
-more information.
+\fBTcl_Main\fR does not return.  Normally a program based on
+\fBTcl_Main\fR will terminate when the \fBexit\fR command is
+evaluated.  In interactive mode, if an EOF or channel error
+is encountered on the standard input channel, then \fBTcl_Main\fR
+itself will evaluate the \fBexit\fR command after the main loop
+procedure (if any) returns.  In non-interactive mode, after
+\fBTcl_Main\fR evaluates the startup script, and the main loop
+procedure (if any) returns, \fBTcl_Main\fR will also evaluate
+the \fBexit\fR command.
 
 .SH "SEE ALSO"
-Tcl_GetStdChannel(3)
+tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3),
+exit(n)
 
 .SH KEYWORDS
 application-specific initialization, command-line arguments, main program
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 23dfdd0..1b7915b 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tclInt.decls,v 1.38 2001/11/23 01:26:47 das Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.39 2002/01/05 22:55:51 dgp Exp $
 
 library tcl
 
@@ -611,10 +611,10 @@ declare 157 generic {
     Var * TclVarTraceExists (Tcl_Interp *interp, char *varName)
 }
 declare 158 generic {
-    void TclSetStartupScriptFileName(char *filename)
+    void TclSetStartupScriptFileName(CONST char *filename)
 }
 declare 159 generic {
-    char *TclGetStartupScriptFileName(void)
+    CONST char *TclGetStartupScriptFileName(void)
 }
 #declare 160 generic {
 #    int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, \
@@ -660,6 +660,15 @@ declare 166 generic {
                                Tcl_Obj* valuePtr   )
 }
 
+# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
+declare 167 generic {
+    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
+}
+declare 168 generic {
+    Tcl_Obj *TclGetStartupScriptPath(void)
+}
+
+
 ##############################################################################
 
 # Define the platform specific internal Tcl interface. These functions are
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 5e36ba9..9e4574e 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIntDecls.h,v 1.31 2001/11/14 23:17:03 hobbs Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.32 2002/01/05 22:55:51 dgp Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -477,9 +477,9 @@ EXTERN Var *		TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp,
 				char * varName));
 /* 158 */
 EXTERN void		TclSetStartupScriptFileName _ANSI_ARGS_((
-				char * filename));
+				CONST char * filename));
 /* 159 */
-EXTERN char *		TclGetStartupScriptFileName _ANSI_ARGS_((void));
+EXTERN CONST char *	TclGetStartupScriptFileName _ANSI_ARGS_((void));
 /* Slot 160 is reserved */
 /* 161 */
 EXTERN int		TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp, 
@@ -497,6 +497,11 @@ EXTERN void		TclpSetInitialEncodings _ANSI_ARGS_((void));
 EXTERN int		TclListObjSetElement _ANSI_ARGS_((Tcl_Interp* interp, 
 				Tcl_Obj* listPtr, int index, 
 				Tcl_Obj* valuePtr));
+/* 167 */
+EXTERN void		TclSetStartupScriptPath _ANSI_ARGS_((
+				Tcl_Obj * pathPtr));
+/* 168 */
+EXTERN Tcl_Obj *	TclGetStartupScriptPath _ANSI_ARGS_((void));
 
 typedef struct TclIntStubs {
     int magic;
@@ -692,8 +697,8 @@ typedef struct TclIntStubs {
     void *reserved155;
     void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, int status)); /* 156 */
     Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
-    void (*tclSetStartupScriptFileName) _ANSI_ARGS_((char * filename)); /* 158 */
-    char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
+    void (*tclSetStartupScriptFileName) _ANSI_ARGS_((CONST char * filename)); /* 158 */
+    CONST char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
     void *reserved160;
     int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */
     void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */
@@ -701,6 +706,8 @@ typedef struct TclIntStubs {
     void (*tclExpandCodeArray) _ANSI_ARGS_((void * envPtr)); /* 164 */
     void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 165 */
     int (*tclListObjSetElement) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* listPtr, int index, Tcl_Obj* valuePtr)); /* 166 */
+    void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */
+    Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -1309,6 +1316,14 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclListObjSetElement \
 	(tclIntStubsPtr->tclListObjSetElement) /* 166 */
 #endif
+#ifndef TclSetStartupScriptPath
+#define TclSetStartupScriptPath \
+	(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
+#endif
+#ifndef TclGetStartupScriptPath
+#define TclGetStartupScriptPath \
+	(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 8b4ef51..0678e3f 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclMain.c,v 1.14 2001/11/23 01:28:53 das Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.15 2002/01/05 22:55:52 dgp Exp $
  */
 
 #include "tcl.h"
@@ -33,9 +33,6 @@ int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
  * Declarations for various library procedures and variables (don't want
  * to include tclPort.h here, because people might copy this file out of
  * the Tcl source directory to make their own modified versions).
- * Note:  "exit" should really be declared here, but there's no way to
- * declare it without causing conflicts with other definitions elsewher
- * on some systems, so it's better just to leave it out.
  */
 
 #if !defined(MAC_TCL)
@@ -43,29 +40,42 @@ extern int		isatty _ANSI_ARGS_((int fd));
 #else
 #include <unistd.h>
 #endif
-extern char *		strcpy _ANSI_ARGS_((char *dst, CONST char *src));
 
-static char *tclStartupScriptFileName = NULL;
+static Tcl_Obj *tclStartupScriptPath = NULL;
 
 static Tcl_MainLoopProc *mainLoopProc = NULL;
 
-typedef struct ThreadSpecificData {
-    Tcl_Interp *interp;         /* Interpreter for this thread. */
-    Tcl_DString command;        /* Used to assemble lines of terminal input
-				 * into Tcl commands. */
-    Tcl_DString line;           /* Used to read the next line from the
-				 * terminal input. */
+/* 
+ * Structure defintiion for information used to keep the state of
+ * an interactive command processor that reads lines from standard
+ * input and writes prompts and results to standard output.
+ */
+
+typedef enum {
+    PROMPT_NONE,	/* Print no prompt */
+    PROMPT_START,	/* Print prompt for command start */
+    PROMPT_CONTINUE	/* Print prompt for command continuation */
+} PromptType;
+
+typedef struct InteractiveState {
+    Tcl_Channel input;		/* The standard input channel from which
+				 * lines are read. */
     int tty;                    /* Non-zero means standard input is a 
 				 * terminal-like device.  Zero means it's
 				 * a file. */
-} ThreadSpecificData;
-Tcl_ThreadDataKey dataKey;
+    Tcl_Obj *commandPtr;	/* Used to assemble lines of input into
+				 * Tcl commands. */
+    PromptType prompt;		/* Next prompt to print */
+    Tcl_Interp *interp;		/* Interpreter that evaluates interactive
+				 * commands. */
+} InteractiveState;
 
 /*
  * Forward declarations for procedures defined later in this file.
  */
 
-static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
+static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp,
+			    PromptType *promptPtr));
 static void		StdinProc _ANSI_ARGS_((ClientData clientData,
 			    int mask));
 
@@ -73,6 +83,58 @@ static void		StdinProc _ANSI_ARGS_((ClientData clientData,
 /*
  *----------------------------------------------------------------------
  *
+ * TclSetStartupScriptPath --
+ *
+ *	Primes the startup script VFS path, used to override the
+ *      command line processing.
+ *
+ * Results:
+ *	None. 
+ *
+ * Side effects:
+ *	This procedure initializes the VFS path of the Tcl script to
+ *      run at startup.
+ *
+ *----------------------------------------------------------------------
+ */
+void TclSetStartupScriptPath(pathPtr)
+    Tcl_Obj *pathPtr;
+{
+    if (tclStartupScriptPath != NULL) {
+	Tcl_DecrRefCount(tclStartupScriptPath);
+    }
+    tclStartupScriptPath = pathPtr;
+    if (tclStartupScriptPath != NULL) {
+	Tcl_IncrRefCount(tclStartupScriptPath);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetStartupScriptPath --
+ *
+ *	Gets the startup script VFS path, used to override the
+ *      command line processing.
+ *
+ * Results:
+ *	The startup script VFS path, NULL if none has been set.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *TclGetStartupScriptPath()
+{
+    return tclStartupScriptPath;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclSetStartupScriptFileName --
  *
  *	Primes the startup script file name, used to override the
@@ -88,9 +150,10 @@ static void		StdinProc _ANSI_ARGS_((ClientData clientData,
  *----------------------------------------------------------------------
  */
 void TclSetStartupScriptFileName(fileName)
-    char *fileName;
+    CONST char *fileName;
 {
-    tclStartupScriptFileName = fileName;
+    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
+    TclSetStartupScriptPath(pathPtr);
 }
 
 
@@ -110,9 +173,9 @@ void TclSetStartupScriptFileName(fileName)
  *
  *----------------------------------------------------------------------
  */
-char *TclGetStartupScriptFileName()
+CONST char *TclGetStartupScriptFileName()
 {
-    return tclStartupScriptFileName;
+    return Tcl_GetString(TclGetStartupScriptPath());
 }
 
 
@@ -148,22 +211,18 @@ Tcl_Main(argc, argv, appInitProc)
 {
     Tcl_Obj *resultPtr;
     Tcl_Obj *commandPtr = NULL;
-    char buffer[1000], *args;
-    int code, gotPartial, length;
+    char buffer[TCL_INTEGER_SPACE + 5], *args;
+    PromptType prompt = PROMPT_START;
+    int code, length, tty;
     int exitCode = 0;
     Tcl_Channel inChannel, outChannel, errChannel;
     Tcl_Interp *interp;
     Tcl_DString argString;
-    ThreadSpecificData *tsdPtr;
 
     Tcl_FindExecutable(argv[0]);
 
-    tsdPtr = (ThreadSpecificData *) 
-	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-    tsdPtr->interp = interp = Tcl_CreateInterp();
-#ifdef TCL_MEM_DEBUG
+    interp = Tcl_CreateInterp();
     Tcl_InitMemory(interp);
-#endif
 
     /*
      * Make command-line arguments available in the Tcl variables "argc"
@@ -171,9 +230,9 @@ Tcl_Main(argc, argv, appInitProc)
      * strip it off and use it as the name of a script file to process.
      */
 
-    if (tclStartupScriptFileName == NULL) {
+    if (TclGetStartupScriptPath() == NULL) {
 	if ((argc > 1) && (argv[1][0] != '-')) {
-	    tclStartupScriptFileName = argv[1];
+	    TclSetStartupScriptFileName(argv[1]);
 	    argc--;
 	    argv++;
 	}
@@ -184,14 +243,14 @@ Tcl_Main(argc, argv, appInitProc)
     Tcl_DStringFree(&argString);
     ckfree(args);
 
-    if (tclStartupScriptFileName == NULL) {
+    if (TclGetStartupScriptPath() == NULL) {
 	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
     } else {
-	tclStartupScriptFileName = Tcl_ExternalToUtfDString(NULL,
-		tclStartupScriptFileName, -1, &argString);
+	TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
+		TclGetStartupScriptFileName(), -1, &argString));
     }
 
-    TclFormatInt(buffer, argc-1);
+    TclFormatInt(buffer, (long) argc-1);
     Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
     Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
 
@@ -199,15 +258,16 @@ Tcl_Main(argc, argv, appInitProc)
      * Set the "tcl_interactive" variable.
      */
 
-    tsdPtr->tty = isatty(0);
+    tty = isatty(0);
     Tcl_SetVar(interp, "tcl_interactive",
-	    ((tclStartupScriptFileName == NULL) && tsdPtr->tty) ? "1" : "0",
+	    ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
 	    TCL_GLOBAL_ONLY);
     
     /*
      * Invoke application-specific initialization.
      */
 
+    Tcl_Preserve((ClientData) interp);
     if ((*appInitProc)(interp) != TCL_OK) {
 	errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	if (errChannel) {
@@ -217,17 +277,21 @@ Tcl_Main(argc, argv, appInitProc)
 	    Tcl_WriteChars(errChannel, "\n", 1);
 	}
     }
+    if (Tcl_InterpDeleted(interp)) {
+	goto done;
+    }
 
     /*
      * If a script file was specified then just source that file
      * and quit.
      */
 
-    if (tclStartupScriptFileName != NULL) {
-	code = Tcl_EvalFile(interp, tclStartupScriptFileName);
+    if (TclGetStartupScriptPath() != NULL) {
+	code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
 	if (code != TCL_OK) {
 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	    if (errChannel) {
+
 		/*
 		 * The following statement guarantees that the errorInfo
 		 * variable is set properly.
@@ -260,49 +324,44 @@ Tcl_Main(argc, argv, appInitProc)
     commandPtr = Tcl_NewObj();
     Tcl_IncrRefCount(commandPtr);
 
+    /*
+     * Get a new value for tty if anyone writes to ::tcl_interactive
+     */
+    Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
     inChannel = Tcl_GetStdChannel(TCL_STDIN);
     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-    gotPartial = 0;
-    while (1) {
-	if (tsdPtr->tty) {
-	    Tcl_Obj *promptCmdPtr;
-
-	    promptCmdPtr = Tcl_GetVar2Ex(interp,
-		    (gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
-		    NULL, TCL_GLOBAL_ONLY);
-	    if (promptCmdPtr == NULL) {
-                defaultPrompt:
-		if (!gotPartial && outChannel) {
-		    Tcl_WriteChars(outChannel, "% ", 2);
-		}
-	    } else {
-		code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
-		inChannel = Tcl_GetStdChannel(TCL_STDIN);
-		outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-		errChannel = Tcl_GetStdChannel(TCL_STDERR);
-		if (code != TCL_OK) {
-		    if (errChannel) {
-			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
-			Tcl_WriteChars(errChannel, "\n", 1);
-		    }
-		    Tcl_AddErrorInfo(interp,
-			    "\n    (script that generates prompt)");
-		    goto defaultPrompt;
-		}
+    while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
+	if (tty) {
+	    Prompt(interp, &prompt);
+	    if (Tcl_InterpDeleted(interp)) {
+		break;
 	    }
-	    if (outChannel) {
-		Tcl_Flush(outChannel);
+	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
+	    if (inChannel == (Tcl_Channel) NULL) {
+	        break;
 	    }
 	}
-	if (!inChannel) {
-	    goto done;
-	}
         length = Tcl_GetsObj(inChannel, commandPtr);
 	if (length < 0) {
-	    goto done;
-	}
-	if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
-	    goto done;
+	    if (Tcl_InputBlocked(inChannel)) {
+
+		/*
+		 * This can only happen if stdin has been set to
+		 * non-blocking.  In that case cycle back and try
+		 * again.  This sets up a tight polling loop (since
+		 * we have no event loop running).  If this causes
+		 * bad CPU hogging, we might try toggling the blocking
+		 * on stdin instead.
+		 */
+
+		continue;
+	    }
+
+	    /* 
+	     * Either EOF, or an error on stdin; we're done
+	     */
+
+	    break;
 	}
 
         /*
@@ -311,12 +370,12 @@ Tcl_Main(argc, argv, appInitProc)
 
 	Tcl_AppendToObj(commandPtr, "\n", 1);
 	if (!TclObjCommandComplete(commandPtr)) {
-	    gotPartial = 1;
+	    prompt = PROMPT_CONTINUE;
 	    continue;
 	}
 
-	gotPartial = 0;
-	code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
+	prompt = PROMPT_START;
+	code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
 	inChannel = Tcl_GetStdChannel(TCL_STDIN);
 	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
 	errChannel = Tcl_GetStdChannel(TCL_STDERR);
@@ -328,7 +387,7 @@ Tcl_Main(argc, argv, appInitProc)
 		Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
 		Tcl_WriteChars(errChannel, "\n", 1);
 	    }
-	} else if (tsdPtr->tty) {
+	} else if (tty) {
 	    resultPtr = Tcl_GetObjResult(interp);
 	    Tcl_GetStringFromObj(resultPtr, &length);
 	    if ((length > 0) && outChannel) {
@@ -337,43 +396,71 @@ Tcl_Main(argc, argv, appInitProc)
 	    }
 	}
 	if (mainLoopProc != NULL) {
+
 	    /*
 	     * If a main loop has been defined while running interactively,
 	     * we want to start a fileevent based prompt by establishing a
 	     * channel handler for stdin.
 	     */
 
+	    InteractiveState *isPtr = NULL;
+
 	    if (inChannel) {
+	        if (tty) {
+		    Prompt(interp, &prompt);
+	        }
+		isPtr = (InteractiveState *) 
+			ckalloc((int) sizeof(InteractiveState));
+		isPtr->input = inChannel;
+		isPtr->tty = tty;
+		isPtr->commandPtr = commandPtr;
+		isPtr->prompt = prompt;
+		isPtr->interp = interp;
+
+		Tcl_UnlinkVar(interp, "tcl_interactive");
+		Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
+			TCL_LINK_BOOLEAN);
+
 		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
-			(ClientData) inChannel);
+			(ClientData) isPtr);
 	    }
-	    if (tsdPtr->tty) {
-		Prompt(interp, 0);
-	    }
-	    Tcl_DStringInit(&tsdPtr->command);
-	    Tcl_DStringInit(&tsdPtr->line);
 
 	    (*mainLoopProc)();
 	    mainLoopProc = NULL;
-	    break;
+
+	    if (inChannel) {
+		tty = isPtr->tty;
+		Tcl_UnlinkVar(interp, "tcl_interactive");
+		Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
+			TCL_LINK_BOOLEAN);
+		prompt = isPtr->prompt;
+		if (isPtr->input != (Tcl_Channel) NULL) {
+		    Tcl_DeleteChannelHandler(isPtr->input, StdinProc,
+			    (ClientData) isPtr);
+		}
+		ckfree((char *)isPtr);
+	    }
+	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
+	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	}
 #ifdef TCL_MEM_DEBUG
+
+	/*
+	 * This code here only for the (unsupported and deprecated)
+	 * [checkmem] command.
+	 */
+
 	if (tclMemDumpFileName != NULL) {
-	    Tcl_DecrRefCount(commandPtr);
+	    mainLoopProc = NULL;
 	    Tcl_DeleteInterp(interp);
-	    Tcl_Exit(0);
 	}
 #endif
     }
 
-    /*
-     * Rather than calling exit, invoke the "exit" command so that
-     * users can replace "exit" with some other command to do additional
-     * cleanup on exit.  The Tcl_Eval call should never return.
-     */
-
     done:
     if ((exitCode == 0) && (mainLoopProc != NULL)) {
+
 	/*
 	 * If everything has gone OK so far, call the main loop proc,
 	 * if it exists.  Packages (like Tk) can set it to start processing
@@ -386,8 +473,36 @@ Tcl_Main(argc, argv, appInitProc)
     if (commandPtr != NULL) {
 	Tcl_DecrRefCount(commandPtr);
     }
-    sprintf(buffer, "exit %d", exitCode);
-    Tcl_Eval(interp, buffer);
+
+    /*
+     * Rather than calling exit, invoke the "exit" command so that
+     * users can replace "exit" with some other command to do additional
+     * cleanup on exit.  The Tcl_Eval call should never return.
+     */
+
+    if (!Tcl_InterpDeleted(interp)) {
+        sprintf(buffer, "exit %d", exitCode);
+        Tcl_Eval(interp, buffer);
+
+        /*
+         * If Tcl_Eval returns, trying to eval [exit], something
+         * unusual is happening.  Maybe interp has been deleted;
+         * maybe [exit] was redefined.  We still want to cleanup
+         * and exit.
+         */
+
+        if (!Tcl_InterpDeleted(interp)) {
+            Tcl_DeleteInterp(interp);
+        }
+    }
+
+    /*
+     * If we get here, the master interp has been deleted.  Allow
+     * its destruction with the last matching Tcl_Release.
+     */
+
+    Tcl_Release((ClientData) interp);
+    Tcl_Exit(exitCode);
 }
 
 /*
@@ -437,40 +552,38 @@ Tcl_SetMainLoop(proc)
     /* ARGSUSED */
 static void
 StdinProc(clientData, mask)
-    ClientData clientData;		/* Not used. */
+    ClientData clientData;		/* The state of interactive cmd line */
     int mask;				/* Not used. */
 {
-    static int gotPartial = 0;
-    char *cmd;
-    int code, count;
-    Tcl_Channel chan = (Tcl_Channel) clientData;
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
-            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-    Tcl_Interp *interp = tsdPtr->interp;
-
-    count = Tcl_Gets(chan, &tsdPtr->line);
-
-    if (count < 0) {
-	if (!gotPartial) {
-	    if (tsdPtr->tty) {
-		Tcl_Exit(0);
-	    } else {
-		Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
-	    }
+    InteractiveState *isPtr = (InteractiveState *) clientData;
+    Tcl_Channel chan = isPtr->input;
+    Tcl_Obj *commandPtr = isPtr->commandPtr;
+    Tcl_Interp *interp = isPtr->interp;
+    int code, length;
+
+    length = Tcl_GetsObj(chan, commandPtr);
+    if (length < 0) {
+	if (Tcl_InputBlocked(chan)) {
 	    return;
-	} 
+	}
+	if (isPtr->tty) {
+	    /*
+	     * Would be better to find a way to exit the mainLoop?
+	     * Or perhaps evaluate [exit]?  Leaving as is for now due
+	     * to compatibility concerns.
+	     */
+	    Tcl_Exit(0);
+	}
+	Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
+	return;
     }
 
-    (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
-            &tsdPtr->line), -1);
-    Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
-    cmd = Tcl_DStringValue(&tsdPtr->command);
-    Tcl_DStringFree(&tsdPtr->line);
-    if (!Tcl_CommandComplete(cmd)) {
-        gotPartial = 1;
+    Tcl_AppendToObj(commandPtr, "\n", 1);
+    if (!TclObjCommandComplete(commandPtr)) {
+        isPtr->prompt = PROMPT_CONTINUE;
         goto prompt;
     }
-    gotPartial = 0;
+    isPtr->prompt = PROMPT_START;
 
     /*
      * Disable the stdin channel handler while evaluating the command;
@@ -480,34 +593,41 @@ StdinProc(clientData, mask)
      * command being evaluated.
      */
 
-    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
-    code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
-    
-    chan = Tcl_GetStdChannel(TCL_STDIN);
-    if (chan) {
+    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
+    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
+    isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
+    Tcl_DecrRefCount(commandPtr);
+    isPtr->commandPtr = commandPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(commandPtr);
+    if (chan != (Tcl_Channel) NULL) {
 	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
-		(ClientData) chan);
+		(ClientData) isPtr);
     }
-    Tcl_DStringFree(&tsdPtr->command);
-    if (Tcl_GetStringResult(interp)[0] != '\0') {
-	if ((code != TCL_OK) || (tsdPtr->tty)) {
-	    chan = Tcl_GetStdChannel(TCL_STDOUT);
-	    if (chan) {
-		Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
-		Tcl_WriteChars(chan, "\n", 1);
-	    }
+    if (code != TCL_OK) {
+	Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	if (errChannel != (Tcl_Channel) NULL) {
+	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+	    Tcl_WriteChars(errChannel, "\n", 1);
+	}
+    } else if (isPtr->tty) {
+	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+	Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	Tcl_GetStringFromObj(resultPtr, &length);
+	if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
+	    Tcl_WriteObj(outChannel, resultPtr);
+	    Tcl_WriteChars(outChannel, "\n", 1);
 	}
     }
 
     /*
-     * Output a prompt.
+     * If a tty stdin is still around, output a prompt.
      */
 
     prompt:
-    if (tsdPtr->tty) {
-	Prompt(interp, gotPartial);
+    if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
+	Prompt(interp, &(isPtr->prompt));
+	isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
     }
-    Tcl_ResetResult(interp);
 }
 
 /*
@@ -529,45 +649,39 @@ StdinProc(clientData, mask)
  */
 
 static void
-Prompt(interp, partial)
+Prompt(interp, promptPtr)
     Tcl_Interp *interp;			/* Interpreter to use for prompting. */
-    int partial;			/* Non-zero means there already
-					 * exists a partial command, so use
-					 * the secondary prompt. */
+    PromptType *promptPtr;		/* Points to type of prompt to print.
+					 * Filled with PROMPT_NONE after a
+					 * prompt is printed. */
 {
-    char *promptCmd;
+    Tcl_Obj *promptCmdPtr;
     int code;
     Tcl_Channel outChannel, errChannel;
 
-    promptCmd = Tcl_GetVar(interp,
-	partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
-    if (promptCmd == NULL) {
-defaultPrompt:
-	if (!partial) {
-
-            /*
-             * We must check that outChannel is a real channel - it
-             * is possible that someone has transferred stdout out of
-             * this interpreter with "interp transfer".
-             */
-
-	    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
-            if (outChannel != (Tcl_Channel) NULL) {
-                Tcl_WriteChars(outChannel, "% ", 2);
-            }
+    if (*promptPtr == PROMPT_NONE) {
+	return;
+    }
+
+    promptCmdPtr = Tcl_GetVar2Ex(interp,
+	    ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
+	    NULL, TCL_GLOBAL_ONLY);
+    if (Tcl_InterpDeleted(interp)) {
+	return;
+    }
+    if (promptCmdPtr == NULL) {
+	defaultPrompt:
+	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	if ((*promptPtr == PROMPT_START)
+		&& (outChannel != (Tcl_Channel) NULL)) {
+	    Tcl_WriteChars(outChannel, "% ", 2);
 	}
     } else {
-	code = Tcl_Eval(interp, promptCmd);
+	code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
 	if (code != TCL_OK) {
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (script that generates prompt)");
-            /*
-             * We must check that errChannel is a real channel - it
-             * is possible that someone has transferred stderr out of
-             * this interpreter with "interp transfer".
-             */
-            
-	    errChannel = Tcl_GetChannel(interp, "stderr", NULL);
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
             if (errChannel != (Tcl_Channel) NULL) {
                 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
                 Tcl_WriteChars(errChannel, "\n", 1);
@@ -575,8 +689,9 @@ defaultPrompt:
 	    goto defaultPrompt;
 	}
     }
-    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
+    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
     if (outChannel != (Tcl_Channel) NULL) {
 	Tcl_Flush(outChannel);
     }
+    *promptPtr = PROMPT_NONE;
 }
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 0a03bc9..9f739bd 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.65 2001/11/23 01:29:01 das Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.66 2002/01/05 22:55:52 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -246,6 +246,8 @@ TclIntStubs tclIntStubs = {
     TclExpandCodeArray, /* 164 */
     TclpSetInitialEncodings, /* 165 */
     TclListObjSetElement, /* 166 */
+    TclSetStartupScriptPath, /* 167 */
+    TclGetStartupScriptPath, /* 168 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
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;
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/tests/main.test b/tests/main.test
new file mode 100644
index 0000000..62c9631
--- /dev/null
+++ b/tests/main.test
@@ -0,0 +1,1048 @@
+# This file contains a collection of tests for generic/tclMain.c.
+#
+# RCS: @(#) $Id: main.test,v 1.1 2002/01/05 22:55:52 dgp Exp $
+
+if {[catch {package require tcltest 2}]} {
+    puts stderr "Skipping tests in [info script]. tcltest v2 needed."
+    return
+}
+
+namespace eval ::tcl::main::test {
+
+    namespace import ::tcltest::test
+    namespace import ::tcltest::testConstraint
+    namespace import ::tcltest::interpreter
+    namespace import ::tcltest::cleanupTests
+    namespace import ::tcltest::makeFile
+    namespace import ::tcltest::removeFile
+
+    # Is [exec] defined?
+    testConstraint exec [llength [info commands exec]]
+
+    # Is the Tcltest package loaded?
+    #	- that is, the special C-coded testing commands in tclTest.c
+    #   - tests use testing commands introduced in Tcltest 8.4
+    testConstraint Tcltest [expr {
+	[llength [package provide Tcltest]]
+	&& [package vsatisfies [package provide Tcltest] 8.4]}]
+
+    # Procedure to simulate interactive typing of commands, line by line
+    proc type {chan script} {
+	foreach line [split $script \n] {
+	    if {[catch {
+	        puts $chan $line
+	        flush $chan
+	    }]} {
+		return
+	    }
+	    # Grrr... Behavior depends on this value.
+	    after 1000
+	}
+    }
+
+    # Tests Tcl_Main-1.*: variable initializations
+
+    test Tcl_Main-1.1 {
+	Tcl_Main: startup script - normal
+    } -constraints [list exec] -setup {
+	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+	set f [open "|[interpreter] script" r]
+    } -body {
+	read $f
+    } -cleanup {
+	close $f
+	removeFile script
+    } -result [list script {} 0]\n
+
+    test Tcl_Main-1.2 {
+	Tcl_Main: startup script - can't begin with '-'
+    } -constraints [list exec] -setup {
+	makeFile {puts [list $argv0 $argv $tcl_interactive]} -script
+	set f [open "|[interpreter] -script" w+]
+    } -body {
+	puts $f {puts [list $argv0 $argv $tcl_interactive]; exit}
+	flush $f
+	read $f
+    } -cleanup {
+	close $f
+	removeFile -script
+    } -result [list [interpreter] -script 0]\n
+
+    test Tcl_Main-1.3 {
+	Tcl_Main: encoding of arguments: system encoding loss
+    } -constraints [list exec] -setup {
+	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+	set f [open "|[interpreter] script \u0098" r]
+    } -body {
+	read $f
+    } -cleanup {
+	close $f
+	removeFile script
+    } -result [list script [list \u0098] 0]\n
+
+    test Tcl_Main-1.4 {
+	Tcl_Main: encoding of arguments: system encoding loss
+	This test fails due to shortcoming noted in Tcl Patch 491789
+    } -constraints [list exec knownBug] -setup {
+	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+	set f [open "|[interpreter] script \u1234" r]
+    } -body {
+	read $f
+    } -cleanup {
+	close $f
+	removeFile script
+    } -result [list script [list \u1234] 0]\n
+
+    test Tcl_Main-1.5 {
+	Tcl_Main: encoding of script name: system encoding loss
+    } -constraints [list exec] -setup {
+	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u0098
+	set f [open "|[interpreter] \u0098" r]
+    } -body {
+	read $f
+    } -cleanup {
+	close $f
+	removeFile \u0098
+    } -result [list [list \u0098] {} 0]\n
+
+    test Tcl_Main-1.6 {
+	Tcl_Main: encoding of script name: system encoding loss
+	This test fails due to shortcoming noted in Tcl Patch 491789
+    } -constraints [list exec knownBug] -setup {
+	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u1234
+	set f [open "|[interpreter] \u1234" r]
+    } -body {
+	read $f
+    } -cleanup {
+	close $f
+	removeFile \u1234
+    } -result [list [list \u1234] {} 0]\n
+
+    # Tests Tcl_Main-2.*: application-initialization procedure
+
+    test Tcl_Main-2.1 {
+	Tcl_Main: appInitProc returns error
+    } -constraints [list exec Tcltest] -setup {
+	makeFile {puts "In script"} script
+    } -body {
+	exec [interpreter] script -appinitprocerror >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -result "application-specific initialization failed: \nIn script\n"
+
+    test Tcl_Main-2.2 {
+	Tcl_Main: appInitProc returns error
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {puts "In script"} -appinitprocerror >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "application-specific initialization failed: \nIn script\n"
+
+    test Tcl_Main-2.3 {
+	Tcl_Main: appInitProc deletes interp
+    } -constraints [list exec Tcltest] -setup {
+	makeFile {puts "In script"} script
+    } -body {
+	exec [interpreter] script -appinitprocdeleteinterp >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -result "application-specific initialization failed: \n"
+
+    test Tcl_Main-2.4 {
+	Tcl_Main: appInitProc deletes interp
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {puts "In script"} \
+		-appinitprocdeleteinterp >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "application-specific initialization failed: \n"
+
+    test Tcl_Main-2.5 {
+	Tcl_Main: appInitProc closes stderr
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {puts "In script"} \
+		-appinitprocclosestderr >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "In script\n"
+
+    # Tests Tcl_Main-3.*: startup script evaluation
+
+    test Tcl_Main-3.1 {
+	Tcl_Main: startup script does not exist
+    } -constraints [list exec] -setup {
+	catch {removeFile no-such-file}
+    } -body {
+	set code [catch {exec [interpreter] no-such-file >& result} result]
+	set f [open result]
+	list $code $result [read $f]
+    } -cleanup {
+	close $f
+	file delete result
+    } -match glob -result [list 1 {child process exited abnormally} \
+	{couldn't read file "no-such-file":*}]
+
+    test Tcl_Main-3.2 {
+	Tcl_Main: startup script raises error
+    } -constraints [list exec] -setup {
+	makeFile {error ERROR} script
+    } -body {
+	set code [catch {exec [interpreter] script >& result} result]
+	set f [open result]
+	list $code $result [read $f]
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -match glob -result [list 1 {child process exited abnormally} \
+	"ERROR\n    while executing*"]
+
+    test Tcl_Main-3.3 {
+	Tcl_Main: startup script closes stderr
+    } -constraints [list exec] -setup {
+	makeFile {close stderr; error ERROR} script
+    } -body {
+	set code [catch {exec [interpreter] script >& result} result]
+	set f [open result]
+	list $code $result [read $f]
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -result [list 1 {child process exited abnormally} {}]
+
+    test Tcl_Main-3.4 {
+	Tcl_Main: startup script holds incomplete script
+    } -constraints [list exec] -setup {
+	makeFile "if 1 \{" script
+    } -body {
+	set code [catch {exec [interpreter] script >& result} result]
+	set f [open result]
+	list $code $result [read $f]
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -match glob -result [list 1 {child process exited abnormally}\
+	"missing close-brace\n    while executing*"]
+
+    test Tcl_Main-3.5 {
+	Tcl_Main: startup script sets main loop
+    } -constraints [list exec Tcltest] -setup {
+	makeFile {
+		rename exit _exit
+		proc exit {code} {
+		    puts "In exit"
+		    _exit $code
+		}
+		after 0 {
+			puts event
+			testexitmainloop
+		}
+		testexithandler create 0
+		testsetmainloop
+	} script
+    } -body {
+	exec [interpreter] script >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -result "event\nExit MainLoop\nIn exit\neven 0\n"
+
+    test Tcl_Main-3.6 {
+	Tcl_Main: startup script sets main loop and closes stdin
+    } -constraints [list exec Tcltest] -setup {
+	makeFile {
+		close stdin
+		testsetmainloop
+		rename exit _exit
+		proc exit {code} {
+		    puts "In exit"
+		    _exit $code
+		}
+		after 0 {
+			puts event
+			testexitmainloop
+		}
+		testexithandler create 0
+	} script
+    } -body {
+	exec [interpreter] script >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -result "event\nExit MainLoop\nIn exit\neven 0\n"
+
+    test Tcl_Main-3.7 {
+	Tcl_Main: startup script deletes interp
+    } -constraints [list exec Tcltest] -setup {
+	makeFile {
+		rename exit _exit
+		proc exit {code} {
+		    puts "In exit"
+		    _exit $code
+		}
+		testexithandler create 0
+		testinterpdelete {}
+	} script
+    } -body {
+	exec [interpreter] script >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -result "even 0\n"
+
+    test Tcl_Main-3.8 {
+	Tcl_Main: startup script deletes interp and sets mainloop
+    } -constraints [list exec Tcltest] -setup {
+	makeFile {
+		testsetmainloop
+		rename exit _exit
+		proc exit {code} {
+		    puts "In exit"
+		    _exit $code
+		}
+		testexitmainloop
+		testexithandler create 0
+		testinterpdelete {}
+	} script
+    } -body {
+	exec [interpreter] script >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -result "Exit MainLoop\neven 0\n"
+
+    test Tcl_Main-3.9 {
+	Tcl_Main: startup script can set tcl_interactive without limit
+    } -constraints [list exec] -setup {
+	makeFile {set tcl_interactive foo} script
+    } -body {
+	exec [interpreter] script >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile script
+    } -result {}
+
+    # Tests Tcl_Main-4.*: rc file evaluation
+
+    test Tcl_Main-4.1 {
+	Tcl_Main: rcFile evaluation deletes interp
+    } -constraints [list exec Tcltest] -setup {
+	set rc [makeFile {testinterpdelete {}} rc]
+    } -body {
+	exec [interpreter] << {puts "In script"} \
+		-appinitprocsetrcfile $rc >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile rc
+    } -result "application-specific initialization failed: \n"
+
+    test Tcl_Main-4.2 {
+	Tcl_Main: rcFile evaluation closes stdin
+    } -constraints [list exec Tcltest] -setup {
+	set rc [makeFile {close stdin} rc]
+    } -body {
+	exec [interpreter] << {puts "In script"} \
+		-appinitprocsetrcfile $rc >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile rc
+    } -result "application-specific initialization failed: \n"
+
+    test Tcl_Main-4.3 {
+	Tcl_Main: rcFile evaluation closes stdin and sets main loop
+    } -constraints [list exec Tcltest] -setup {
+	set rc [makeFile {
+		close stdin
+		testsetmainloop
+		after 0 testexitmainloop
+		testexithandler create 0
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+	} rc]
+    } -body {
+	exec [interpreter] << {puts "In script"} \
+		-appinitprocsetrcfile $rc >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile rc
+    } -result "application-specific initialization failed:\
+	\nExit MainLoop\nIn exit\neven 0\n"
+
+    test Tcl_Main-4.4 {
+	Tcl_Main: rcFile evaluation sets main loop
+    } -constraints [list exec Tcltest] -setup {
+	set rc [makeFile {
+		testsetmainloop
+		after 0 testexitmainloop
+		testexithandler create 0
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+	} rc]
+    } -body {
+	exec [interpreter] << {puts "In script"} \
+		-appinitprocsetrcfile $rc >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+	removeFile rc
+    } -result "application-specific initialization failed:\
+	\nIn script\nExit MainLoop\nIn exit\neven 0\n"
+
+    # Tests Tcl_Main-5.*: interactive operations
+
+    test Tcl_Main-5.1 {
+	Tcl_Main: tcl_interactive must be boolean
+    } -constraints [list exec] -body {
+	exec [interpreter] << {set tcl_interactive foo} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "can't set \"tcl_interactive\":\
+	     variable must have boolean value\n"
+
+    test Tcl_Main-5.2 {
+	Tcl_Main able to handle non-blocking stdin
+    } -constraints [list exec] -setup {
+	set f [open "|[interpreter]" w+]
+    } -body {
+	type $f {
+	    fconfigure stdin -blocking 0
+	    puts SUCCESS
+	}
+	list [catch {gets $f} line] $line
+    } -cleanup {
+	close $f
+    } -result [list 0 SUCCESS]
+
+    test Tcl_Main-5.3 {
+	Tcl_Main handles stdin EOF in mid-command
+    } -constraints [list exec] -setup {
+	set f [open "|[interpreter]" w+]
+	fconfigure $f -blocking 0
+    } -body {
+	type $f "fconfigure stdin -eofchar \\032
+	    if 1 \{\n\032"
+	variable wait
+	fileevent $f readable \
+		[list set [namespace which -variable wait] "child exit"]
+	after 2000 [list set [namespace which -variable wait] timeout]
+	vwait [namespace which -variable wait]
+	set wait
+    } -cleanup {
+	if {[string equal timeout $wait]
+		&& [string equal unix $::tcl_platform(platform)]} {
+	    exec kill [pid $f]
+	}
+	close $f
+    } -result {child exit}
+
+    test Tcl_Main-5.4 {
+	Tcl_Main handles stdin EOF in mid-command
+    } -constraints [list exec] -setup {
+	set cmd {makeFile "if 1 \{" script}
+	set f [open "|[interpreter] < [eval $cmd]" r]
+	fconfigure $f -blocking 0
+    } -body {
+	variable wait
+	fileevent $f readable \
+		[list set [namespace which -variable wait] "child exit"]
+	after 2000 [list set [namespace which -variable wait] timeout]
+	vwait [namespace which -variable wait]
+	set wait
+    } -cleanup {
+	if {[string equal timeout $wait]
+		&& [string equal unix $::tcl_platform(platform)]} {
+	    exec kill [pid $f]
+	}
+	close $f
+	removeFile script
+    } -result {child exit}
+
+    test Tcl_Main-5.5 {
+	Tcl_Main: error raised in interactive mode
+    } -constraints [list exec] -body {
+	exec [interpreter] << {error foo} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "foo\n"
+
+    test Tcl_Main-5.6 {
+	Tcl_Main: interactive mode: errors don't stop command loop
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		error foo
+		puts bar
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "foo\nbar\n"
+
+    test Tcl_Main-5.7 {
+	Tcl_Main: interactive mode: closed stderr
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		close stderr
+		error foo
+		puts bar
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "bar\n"
+
+    test Tcl_Main-5.8 {
+	Tcl_Main: interactive mode: close stdin
+		-> main loop & [exit] & exit handlers
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+		testsetmainloop
+		testexitmainloop
+		testexithandler create 0
+		close stdin
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+    test Tcl_Main-5.9 {
+	Tcl_Main: interactive mode: delete interp 
+		-> main loop & exit handlers, but no [exit]
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+		testsetmainloop
+		testexitmainloop
+		testexithandler create 0
+		testinterpdelete {}
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "Exit MainLoop\neven 0\n"
+
+    test Tcl_Main-5.10 {
+	Tcl_Main: exit main loop in mid-interactive command
+    } -constraints [list exec Tcltest] -setup {
+	set f [open "|[interpreter]" w+]
+	fconfigure $f -blocking 0
+    } -body {
+	type $f "testsetmainloop
+	         after 2000 testexitmainloop
+	         puts \{1 2"
+	after 4000
+	type $f "3 4\}"
+	set code1 [catch {gets $f} line1]
+	set code2 [catch {gets $f} line2]
+	set code3 [catch {gets $f} line3]
+	list $code1 $line1 $code2 $line2 $code3 $line3
+    } -cleanup {
+	close $f
+    } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}]
+
+    test Tcl_Main-5.11 {
+	Tcl_Main: EOF in interactive main loop
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+		testexithandler create 0
+		after 0 testexitmainloop
+		testsetmainloop
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+    test Tcl_Main-5.12 {
+	Tcl_Main: close stdin in interactive main loop
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+		testexithandler create 0
+		after 100 testexitmainloop
+		testsetmainloop
+		close stdin
+		puts "don't reach this"
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+    # Tests Tcl_Main-6.*: interactive operations with prompts
+
+    test Tcl_Main-6.1 {
+	Tcl_Main: enable prompts with tcl_interactive
+    } -constraints [list exec] -body {
+	exec [interpreter] << {set tcl_interactive 1} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n% "
+
+    test Tcl_Main-6.2 {
+	Tcl_Main: prompt deletes interp
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		set tcl_prompt1 {testinterpdelete {}}
+		set tcl_interactive 1
+		puts "not reached"
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n"
+
+    test Tcl_Main-6.3 {
+	Tcl_Main: prompt closes stdin
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		set tcl_prompt1 {close stdin}
+		set tcl_interactive 1
+		puts "not reached"
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n"
+
+    test Tcl_Main-6.4 {
+	Tcl_Main: interactive output, closed stdout
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		set tcl_interactive 1
+		close stdout
+		set a NO
+		puts stderr YES
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n% YES\n"
+
+    test Tcl_Main-6.5 {
+	Tcl_Main: interactive entry to main loop
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		set tcl_interactive 1
+		testsetmainloop
+		testexitmainloop} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n% % % Exit MainLoop\n"
+
+    test Tcl_Main-6.6 {
+	Tcl_Main: number of prompts during stdin close exit
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		set tcl_interactive 1
+		close stdin} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n% "
+
+    # Tests Tcl_Main-7.*: exiting
+
+    test Tcl_Main-7.1 {
+	Tcl_Main: [exit] defined as no-op -> still have exithandlers
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		proc exit args {}
+		testexithandler create 0
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "even 0\n"
+
+    test Tcl_Main-7.2 {
+	Tcl_Main: [exit] defined as no-op -> still have exithandlers
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		proc exit args {}
+		testexithandler create 0
+		after 0 testexitmainloop
+		testsetmainloop
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "Exit MainLoop\neven 0\n"
+
+    # Tests Tcl_Main-8.*: StdinProc operations
+
+    test Tcl_Main-8.1 {
+	StdinProc: handles non-blocking stdin
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		fconfigure stdin -blocking 0
+		testexitmainloop
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "Exit MainLoop\n"
+
+    test Tcl_Main-8.2 {
+	StdinProc: handles stdin EOF
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		testexithandler create 0
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+		after 100 testexitmainloop
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+    test Tcl_Main-8.3 {
+	StdinProc: handles interactive stdin EOF
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		testexithandler create 0
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+		set tcl_interactive 1} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n% even 0\n"
+
+    test Tcl_Main-8.4 {
+	StdinProc: handles stdin close
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+		after 100 testexitmainloop
+		after 0 puts 1
+		close stdin
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\nExit MainLoop\nIn exit\n"
+
+    test Tcl_Main-8.5 {
+	StdinProc: handles interactive stdin close
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		set tcl_interactive 1
+		rename exit _exit
+		proc exit code {
+		    puts "In exit"
+		    _exit $code
+		}
+		after 100 testexitmainloop
+		after 0 puts 1
+		close stdin
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n"
+
+    test Tcl_Main-8.6 {
+	StdinProc: handles event loop re-entry
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		after 100 {puts 1; set delay 1}
+		vwait delay
+		puts 2
+		testexitmainloop
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n2\nExit MainLoop\n"
+
+    test Tcl_Main-8.7 {
+	StdinProc: handling of errors
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		error foo
+		testexitmainloop
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "foo\nExit MainLoop\n"
+
+    test Tcl_Main-8.8 {
+	StdinProc: handling of errors, closed stderr
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		close stderr
+		error foo
+		testexitmainloop
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "Exit MainLoop\n"
+
+    test Tcl_Main-8.9 {
+	StdinProc: interactive output
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		set tcl_interactive 1
+		testexitmainloop} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n% % Exit MainLoop\n"
+
+    test Tcl_Main-8.10 {
+	StdinProc: interactive output, closed stdout
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		close stdout
+		set tcl_interactive 1
+		testexitmainloop
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result {}
+
+    test Tcl_Main-8.11 {
+	StdinProc: prompt deletes interp
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		set tcl_prompt1 {testinterpdelete {}}
+		set tcl_interactive 1} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n"
+
+    test Tcl_Main-8.12 {
+	StdinProc: prompt closes stdin
+    } -constraints [list exec Tcltest] -body {
+	exec [interpreter] << {
+		testsetmainloop
+		set tcl_prompt1 {close stdin}
+		after 100 testexitmainloop
+		set tcl_interactive 1
+		puts "not reached"
+	} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\nExit MainLoop\n"
+
+    # Tests Tcl_Main-9.*: Prompt operations
+
+    test Tcl_Main-9.1 {
+	Prompt: custom prompt variables
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		set tcl_prompt1 {puts -nonewline stdout "one "}
+		set tcl_prompt2 {puts -nonewline stdout "two "}
+		set tcl_interactive 1
+		puts {This is
+		a test}} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\none two This is\n\t\ta test\none "
+
+    test Tcl_Main-9.2 {
+	Prompt: error in custom prompt variables
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		set tcl_prompt1 {error foo}
+		set tcl_interactive 1
+		set errorInfo} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\nfoo\n% foo\n    while executing\n\"error foo\"\n    (script\
+	that generates prompt)\nfoo\n% "
+
+    test Tcl_Main-9.3 {
+	Prompt: error in custom prompt variables, closed stderr
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		set tcl_prompt1 {close stderr; error foo}
+		set tcl_interactive 1} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\n% "
+
+    test Tcl_Main-9.4 {
+	Prompt: error in custom prompt variables, closed stdout
+    } -constraints [list exec] -body {
+	exec [interpreter] << {
+		set tcl_prompt1 {close stdout; error foo}
+		set tcl_interactive 1} >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "1\nfoo\n"
+
+    cleanupTests
+}
+
+namespace delete ::tcl::main::test
+