Find script library in zipfs archive and inform Tcl library how to direct

every interp to find it when created without fuss.

BACKED OUT the merge to trunk. Multiple reports that the change makes some build configurations fail

2 files changed, 57 insertions, 60 deletions

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index ed3c527..b023615 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -402,7 +402,6 @@ Tcl_Init(
 "if {$tail eq [info tclversion]} continue\n"
 "file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
 "	}\n"
-"	lappend scripts {::tcl::zipfs::tcl_library_init}\n"
 "	if {[info exists tclDefaultLibrary]} {\n"
 "	    lappend scripts {set tclDefaultLibrary}\n"
 "	} else {\n"
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 5df300a..adabcda 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -91,6 +91,17 @@ static const z_crc_t* crc32tab;
 #define ZIPFS_VOLUME_LEN  9
 #define ZIPFS_APP_MOUNT	  ZIPFS_VOLUME "app"
 #define ZIPFS_ZIP_MOUNT	  ZIPFS_VOLUME "lib/tcl"
+
+#define ZIPFS_SCRIPT_PREFIX	"set ::tcl_library "
+#define ZIPFS_TCL_LIBRARY_1	ZIPFS_APP_MOUNT "/tcl_library"
+#define ZIPFS_INIT_SCRIPT_1	ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_1
+
+#define ZIPFS_TCL_LIBRARY_2	ZIPFS_ZIP_MOUNT
+#define ZIPFS_INIT_SCRIPT_2	ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_2
+
+#define ZIPFS_TCL_LIBRARY_3	ZIPFS_ZIP_MOUNT "/tcl_library"
+#define ZIPFS_INIT_SCRIPT_3	ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_3
+
 #define ZIPFS_FALLBACK_ENCODING "cp437"
 
 /*
@@ -313,6 +324,7 @@ static const char pwrot[17] =
     "\x10\x90\x50\xD0\x30\xB0\x70\xF0";
 
 static const char *zipfs_literal_tcl_library = NULL;
+static const char *zipfs_init_script = NULL;
 
 /* Function prototypes */
 
@@ -4231,6 +4243,28 @@ ScriptLibrarySetup(
     Tcl_Obj *libDirObj = Tcl_NewStringObj(dirName, -1);
     Tcl_Obj *subDirObj, *searchPathObj;
 
+    /*
+     * We know where the init.tcl is located in the attached script library
+     * archive.  Use a pre-init script to tell every Tcl interp as it gets
+     * created where that is, so none of them need to construct and then
+     * iterate through some search path.  That's the literal documented
+     * purpose of Tcl_SetPreInitScript().  Use it.
+     *
+     * TODO: Examine why we need so many variations and eliminate as many
+     * as possible.
+     */
+
+    if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_1)) {
+	zipfs_init_script = ZIPFS_INIT_SCRIPT_1;
+    } else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_2)) {
+	zipfs_init_script = ZIPFS_INIT_SCRIPT_2;
+    } else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_3)) {
+	zipfs_init_script = ZIPFS_INIT_SCRIPT_3;
+    }
+    if (zipfs_init_script) {
+	Tcl_SetPreInitScript(zipfs_init_script);
+    }
+
     TclNewLiteralStringObj(subDirObj, "encoding");
     Tcl_IncrRefCount(subDirObj);
     TclNewObj(searchPathObj);
@@ -4268,13 +4302,12 @@ TclZipfs_TclLibrary(void)
      * Look for the library file system within the executable.
      */
 
-    vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
-	    -1);
+    vfsInitScript = Tcl_NewStringObj(ZIPFS_TCL_LIBRARY_1 "/init.tcl", -1);
     Tcl_IncrRefCount(vfsInitScript);
     found = Tcl_FSAccess(vfsInitScript, F_OK);
     Tcl_DecrRefCount(vfsInitScript);
     if (found == TCL_OK) {
-	zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
 	return ScriptLibrarySetup(zipfs_literal_tcl_library);
     }
 
@@ -4323,44 +4356,6 @@ TclZipfs_TclLibrary(void)
 /*
  *-------------------------------------------------------------------------
  *
- * ZipFSTclLibraryObjCmd --
- *
- *	This procedure is invoked to process the
- *	[::tcl::zipfs::tcl_library_init] command, usually called during the
- *	execution of Tcl's interpreter startup. It returns the root that Tcl's
- *	library files are mounted under.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May initialise the cache of where such library files are to be found.
- *	This cache is never cleared.
- *
- *-------------------------------------------------------------------------
- */
-
-static int
-ZipFSTclLibraryObjCmd(
-    TCL_UNUSED(void *),
-    Tcl_Interp *interp,		/* Current interpreter. */
-    TCL_UNUSED(int) /*objc*/,
-    TCL_UNUSED(Tcl_Obj *const *)) /*objv*/
-{
-    if (!Tcl_IsSafe(interp)) {
-	Tcl_Obj *pResult = TclZipfs_TclLibrary();
-
-	if (!pResult) {
-	    TclNewObj(pResult);
-	}
-	Tcl_SetObjResult(interp, pResult);
-    }
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------------
- *
  * ZipChannelClose --
  *
  *	This function is called to close a channel.
@@ -6253,8 +6248,6 @@ TclZipfs_Init(
 	Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
 	Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
 		Tcl_NewStringObj("::tcl::zipfs::find", -1));
-	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
-		ZipFSTclLibraryObjCmd, NULL, NULL);
 	Tcl_PkgProvide(interp, "tcl::zipfs", "2.0");
     }
     return TCL_OK;
@@ -6283,22 +6276,21 @@ ZipfsAppHookFindTclInit(
 	return TCL_ERROR;
     }
 
-    TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
+    TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_2 "/init.tcl");
     Tcl_IncrRefCount(vfsInitScript);
     found = Tcl_FSAccess(vfsInitScript, F_OK);
     Tcl_DecrRefCount(vfsInitScript);
     if (found == 0) {
-	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
+	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_2;
 	return TCL_OK;
     }
 
-    TclNewLiteralStringObj(vfsInitScript,
-	    ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
+    TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_3 "/init.tcl");
     Tcl_IncrRefCount(vfsInitScript);
     found = Tcl_FSAccess(vfsInitScript, F_OK);
     Tcl_DecrRefCount(vfsInitScript);
     if (found == 0) {
-	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
+	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_3;
 	return TCL_OK;
     }
 
@@ -6415,12 +6407,13 @@ TclZipfs_AppHook(
 
 	if (!zipfs_literal_tcl_library) {
 	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
+		    ZIPFS_TCL_LIBRARY_1 "/init.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    found = Tcl_FSAccess(vfsInitScript, F_OK);
 	    Tcl_DecrRefCount(vfsInitScript);
 	    if (found == TCL_OK) {
-		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+		zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
+		Tcl_DecrRefCount(TclZipfs_TclLibrary());
 		return version;
 	    }
 	}
@@ -6447,9 +6440,9 @@ TclZipfs_AppHook(
 	     * wants it.
 	     */
 
-	    TclZipfs_TclLibrary();
+	    Tcl_DecrRefCount(TclZipfs_TclLibrary());
 	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
+		    ZIPFS_TCL_LIBRARY_3 "install.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
 		Tcl_SetStartupScript(vfsInitScript, NULL);
@@ -6459,6 +6452,17 @@ TclZipfs_AppHook(
 	    int found;
 	    Tcl_Obj *vfsInitScript;
 
+	    /* Set Tcl Encodings */
+	    TclNewLiteralStringObj(vfsInitScript,
+		    ZIPFS_TCL_LIBRARY_1 "/init.tcl");
+	    Tcl_IncrRefCount(vfsInitScript);
+	    found = Tcl_FSAccess(vfsInitScript, F_OK);
+	    Tcl_DecrRefCount(vfsInitScript);
+	    if (found == TCL_OK) {
+		zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
+		Tcl_DecrRefCount(TclZipfs_TclLibrary());
+	    }
+
 	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
@@ -6470,14 +6474,8 @@ TclZipfs_AppHook(
 	    } else {
 		Tcl_DecrRefCount(vfsInitScript);
 	    }
-	    /* Set Tcl Encodings */
-	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
-	    Tcl_IncrRefCount(vfsInitScript);
-	    found = Tcl_FSAccess(vfsInitScript, F_OK);
-	    Tcl_DecrRefCount(vfsInitScript);
+
 	    if (found == TCL_OK) {
-		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
 		return version;
 	    }
 	}