Merging in changes from Tcl

Reduced the code necessary to bootstrap a shell to a single C call.

Reduced the number of new stub entries to 1

Fixed a Makefile goof that was preventing kits from running properly.

10 files changed, 106 insertions, 95 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 8352afa..5b0220e 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2328,20 +2328,9 @@ declare 630 {
 
 # ZipVfs
 declare 631 {
-  int Tcl_Zvfs_Init(Tcl_Interp *interp)
+  int Tcl_Zvfs_Boot(Tcl_Interp *interp)
 }
 
-declare 632 {
-  int Tcl_Zvfs_Mount(
-    Tcl_Interp *interp,
-    CONST char *zArchive,
-    CONST char *zMountPoint
-  )
-}
-
-declare 633 {
-  int Tcl_Zvfs_Umount(CONST char *zArchive)
-}
 ##############################################################################
 
 # Define the platform specific public Tcl interface. These functions are only
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 75dd554..06b46f0 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1816,13 +1816,7 @@ EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
 				Tcl_ZlibStream zhandle,
 				Tcl_Obj *compressionDictionaryObj);
 /* 631 */
-EXTERN int		Tcl_Zvfs_Init(Tcl_Interp *interp);
-/* 632 */
-EXTERN int		Tcl_Zvfs_Mount(Tcl_Interp *interp,
-				CONST char *zArchive,
-				CONST char *zMountPoint);
-/* 633 */
-EXTERN int		Tcl_Zvfs_Umount(CONST char *zArchive);
+EXTERN int		Tcl_Zvfs_Boot(Tcl_Interp *interp);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2489,9 +2483,7 @@ typedef struct TclStubs {
     void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
     int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
     void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
-    int (*tcl_Zvfs_Init) (Tcl_Interp *interp); /* 631 */
-    int (*tcl_Zvfs_Mount) (Tcl_Interp *interp, CONST char *zArchive, CONST char *zMountPoint); /* 632 */
-    int (*tcl_Zvfs_Umount) (CONST char *zArchive); /* 633 */
+    int (*tcl_Zvfs_Boot) (Tcl_Interp *interp); /* 631 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3784,12 +3776,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
 #define Tcl_ZlibStreamSetCompressionDictionary \
 	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
-#define Tcl_Zvfs_Init \
-	(tclStubsPtr->tcl_Zvfs_Init) /* 631 */
-#define Tcl_Zvfs_Mount \
-	(tclStubsPtr->tcl_Zvfs_Mount) /* 632 */
-#define Tcl_Zvfs_Umount \
-	(tclStubsPtr->tcl_Zvfs_Umount) /* 633 */
+#define Tcl_Zvfs_Boot \
+	(tclStubsPtr->tcl_Zvfs_Boot) /* 631 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 941d566..ab219a6 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1299,18 +1299,20 @@ Tcl_FinalizeThread(void)
 	TclFinalizeAsync();
 	TclFinalizeThreadObjects();
     }
+    if (TclFullFinalizationRequested()) { /* useless if we are facing a quick-exit */
 
-    /*
-     * Blow away all thread local storage blocks.
-     *
-     * Note that Tcl API allows creation of threads which do not use any Tcl
-     * interp or other Tcl subsytems. Those threads might, however, use thread
-     * local storage, so we must unconditionally finalize it.
-     *
-     * Fix [Bug #571002]
-     */
-
-    TclFinalizeThreadData();
+	/*
+	 * Blow away all thread local storage blocks.
+	 *
+	 * Note that Tcl API allows creation of threads which do not use any Tcl
+	 * interp or other Tcl subsytems. Those threads might, however, use thread
+	 * local storage, so we must unconditionally finalize it.
+	 *
+	 * Fix [Bug #571002]
+	 */
+	
+	TclFinalizeThreadData();
+    }
 }
 
 /*
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 0bf2e8d..360f5e9 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -382,12 +382,6 @@ Tcl_MainEx(
      */
 
     Tcl_Preserve(interp);
-    
-    /*
-     * Check if this shell has an attached VFS
-     */
-    CONST char *cp=Tcl_GetNameOfExecutable();
-    
     if (appInitProc(interp) != TCL_OK) {
 	chan = Tcl_GetStdChannel(TCL_STDERR);
 	if (chan) {
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index b061ba6..ace1766 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1412,9 +1412,7 @@ const TclStubs tclStubs = {
     Tcl_FindSymbol, /* 628 */
     Tcl_FSUnloadFile, /* 629 */
     Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
-    Tcl_Zvfs_Init, /* 631 */
-    Tcl_Zvfs_Mount, /* 632 */
-    Tcl_Zvfs_Umount, /* 633 */
+    Tcl_Zvfs_Boot, /* 631 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c
index 9b377c0..7baf469 100755
--- a/generic/tclZipVfs.c
+++ b/generic/tclZipVfs.c
@@ -1762,6 +1762,43 @@ Zvfs_doInit(
     return TCL_OK;
 }
 
+/*
+** Boot a shell, mount the executable's VFS, detect main.tcl
+*/
+int Tcl_Zvfs_Boot(Tcl_Interp *interp) {
+
+  CONST char *cp=Tcl_GetNameOfExecutable();
+  /* We have to initialize the virtual filesystem before calling
+  ** Tcl_Init().  Otherwise, Tcl_Init() will not be able to find
+  ** its startup script files.
+  */
+  if(Zvfs_doInit(interp, 0)) {
+    return TCL_ERROR;
+  }
+  if(!Tcl_Zvfs_Mount(interp, cp, "/zvfs")) {
+      Tcl_Obj *vfsinitscript=Tcl_NewStringObj("/zvfs/main.tcl",-1);
+      Tcl_Obj *vfstcllib=Tcl_NewStringObj("/zvfs/tcl8.6",-1);
+      Tcl_Obj *vfstklib=Tcl_NewStringObj("/zvfs/tk8.6",-1);
+
+      Tcl_IncrRefCount(vfsinitscript);
+      Tcl_IncrRefCount(vfstcllib);
+      Tcl_IncrRefCount(vfstklib);
+      
+      if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
+        Tcl_SetStartupScript(vfsinitscript,NULL);
+      }
+      if(Tcl_FSAccess(vfstcllib,F_OK)==0) {
+        Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY);
+      }
+      if(Tcl_FSAccess(vfstklib,F_OK)==0) {
+        Tcl_SetVar2(interp, "env", "TK_LIBRARY", Tcl_GetString(vfstklib), TCL_GLOBAL_ONLY);
+      }
+      Tcl_DecrRefCount(vfsinitscript);
+      Tcl_DecrRefCount(vfstcllib);
+  }
+  return TCL_OK;
+}
+
 int
 Tcl_Zvfs_Init(
     Tcl_Interp *interp)
diff --git a/tests/aaa_exit.test b/tests/aaa_exit.test
new file mode 100644
index 0000000..51a94d7
--- /dev/null
+++ b/tests/aaa_exit.test
@@ -0,0 +1,41 @@
+# Commands covered:  exit, emphasis on finalization hangs
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+
+
+test exit-1.1 {normal, quick exit} {
+     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\" 2>@ stderr" r]
+     set aft [after 5000 {set done "Quick exit hangs !!!"}]
+     fileevent $f readable {after cancel $aft;set done OK}
+     vwait done
+     catch {fconfigure $f -blocking 0;close $f}
+     set done
+} OK
+
+test exit-1.2 {full-finalized exit} {
+     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\" 2>@ stderr" r]
+     set aft [after 5000 {set done "Full-finalized exit hangs !!!"}]
+     fileevent $f readable {after cancel $aft;set done OK}
+     vwait done
+     catch {fconfigure $f -blocking 0;close $f}
+     set done
+} OK
+
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/unix/Makefile.in b/unix/Makefile.in
index bb6af0c..8f260d0 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -649,12 +649,16 @@ ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE}
 		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
 		${CC_SEARCH_FLAGS} -o ${TCL_EXE}
 
-${TCLKIT_EXE}: ${TCL_EXE}
+null.zip:
+	touch .empty
+	zip null.zip .empty 
+
+${TCLKIT_EXE}: ${TCL_EXE} null.zip
 	rm -f tclkit.zip
 	PWD=`pwd`
-	cd ${prefix}/lib ; zip -rAq ${PWD}/tclkit.zip tcl8 tcl8.6
 	cp -f ${TCL_EXE} ${TCLKIT_EXE}
-	cat tclkit.zip >> ${TCLKIT_EXE}
+	cat null.zip >> ${TCLKIT_EXE}
+	cd ${prefix}/lib ; zip -rAq ${PWD}/${TCLKIT_EXE} tcl8 tcl8.6
 	
 # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above
 ${NATIVE_TCLSH}:
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index cdfff59..95dc38e 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -108,28 +108,7 @@ int
 Tcl_AppInit(
     Tcl_Interp *interp)		/* Interpreter for application. */
 {
-    CONST char *cp=Tcl_GetNameOfExecutable();
-    /* We have to initialize the virtual filesystem before calling
-    ** Tcl_Init().  Otherwise, Tcl_Init() will not be able to find
-    ** its startup script files.
-    */
-    Tcl_Zvfs_Init(interp);
-    if(!Tcl_Zvfs_Mount(interp, cp, "/zvfs")) {
-      Tcl_Obj *vfsinitscript=Tcl_NewStringObj("/zvfs/main.tcl",-1);
-      Tcl_Obj *vfstcllib=Tcl_NewStringObj("/zvfs/tcl8.6",-1);
-
-      Tcl_IncrRefCount(vfsinitscript);
-      Tcl_IncrRefCount(vfstcllib);
-
-      if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
-        Tcl_SetStartupScript(vfsinitscript,NULL);
-      }
-      if(Tcl_FSAccess(vfstcllib,F_OK)==0) {
-        Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY);
-      }
-      Tcl_DecrRefCount(vfsinitscript);
-      Tcl_DecrRefCount(vfstcllib);
-    }
+    Tcl_Zvfs_Boot(interp);
     
     if ((Tcl_Init)(interp) == TCL_ERROR) {
 	return TCL_ERROR;
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index 7edd455..a8eac66 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -152,28 +152,7 @@ int
 Tcl_AppInit(
     Tcl_Interp *interp)		/* Interpreter for application. */
 {
-    CONST char *cp=Tcl_GetNameOfExecutable();
-    /* We have to initialize the virtual filesystem before calling
-    ** Tcl_Init().  Otherwise, Tcl_Init() will not be able to find
-    ** its startup script files.
-    */
-    Tcl_Zvfs_Init(interp);
-    if(!Tcl_Zvfs_Mount(interp, cp, "/zvfs")) {
-      Tcl_Obj *vfsinitscript=Tcl_NewStringObj("/zvfs/main.tcl",-1);
-      Tcl_Obj *vfstcllib=Tcl_NewStringObj("/zvfs/tcl8.6",-1);
-
-      Tcl_IncrRefCount(vfsinitscript);
-      Tcl_IncrRefCount(vfstcllib);
-
-      if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
-        Tcl_SetStartupScript(vfsinitscript,NULL);
-      }
-      if(Tcl_FSAccess(vfstcllib,F_OK)==0) {
-        Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY);
-      }
-      Tcl_DecrRefCount(vfsinitscript);
-      Tcl_DecrRefCount(vfstcllib);
-    }
+    Tcl_Zvfs_Boot(interp);
     
     if ((Tcl_Init)(interp) == TCL_ERROR) {
 	return TCL_ERROR;