Rebase to 9.0

.github/workflows/win-build.yml

@@ -24,6 +24,7 @@ jobs:
           - ""
           - "CHECKS=nodep"
           - "OPTS=static"
+          - "OPTS=memorymodule"
           - "OPTS=noembed"
           - "OPTS=symbols"
           - "OPTS=symbols STATS=compdbg,memdbg"
@@ -69,6 +70,7 @@ jobs:
           - "CFLAGS=-DTCL_NO_DEPRECATED=1"
           - "--disable-shared"
           - "--disable-zipfs"
+          - "--enable-memorymodule"
           - "--enable-symbols"
           - "--enable-symbols=mem"
           - "--enable-symbols=all"

generic/tclEvent.c

@@ -1072,6 +1072,9 @@ static const struct {
 #ifdef TCL_MEM_DEBUG
 	    ".memdebug"
 #endif
+#if defined(_WIN32) && defined(TCL_LOAD_FROM_MEMORY)
+	    ".memorymodule-0004"
+#endif
 #if defined(_MSC_VER)
 	    ".msvc-" STRINGIFY(_MSC_VER)
 #endif

generic/tclIOUtil.c

@@ -3255,7 +3255,7 @@ Tcl_LoadFile(
 	}
 	ret = Tcl_Read(data, (char *)buffer, size);
 	Tcl_CloseEx(interp, data, 0);
-	ret = TclpLoadMemory(buffer, size, ret, handlePtr,
+	ret = TclpLoadMemory(buffer, size, ret, TclGetString(pathPtr), handlePtr,
 		&unloadProcPtr, flags);
 	if (ret == TCL_OK && *handlePtr != NULL) {
 	    goto resolveSymbols;

generic/tclInt.h

@@ -3263,6 +3263,7 @@ struct Tcl_LoadHandle_ {
 				 * loaded module */
     Tcl_FSUnloadFileProc* unloadFileProcPtr;
 				/* Procedure that unloads a loaded module */
+    char name[TCLFLEXARRAY];
 };
 
 /* Flags for conversion of doubles to digit strings */
@@ -3669,8 +3670,8 @@ MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
 #ifdef TCL_LOAD_FROM_MEMORY
 MODULE_SCOPE void *	TclpLoadMemoryGetBuffer(size_t size);
-MODULE_SCOPE int	TclpLoadMemory(void *buffer,
-			    size_t size, Tcl_Size codeSize, Tcl_LoadHandle *loadHandle,
+MODULE_SCOPE int	TclpLoadMemory(void *buffer, size_t size,
+			    Tcl_Size codeSize,  const char *path, Tcl_LoadHandle *loadHandle,
 			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
 #endif
 MODULE_SCOPE void	TclInitThreadStorage(void);

generic/tclLoadNone.c

@@ -73,6 +73,7 @@ TclpLoadMemory(
     TCL_UNUSED(void *),
     TCL_UNUSED(size_t),
     TCL_UNUSED(Tcl_Size),
+    TCL_UNUSED(const char *),
     TCL_UNUSED(Tcl_LoadHandle *),
     TCL_UNUSED(Tcl_FSUnloadFileProc **),
     TCL_UNUSED(int))

tests/memorymodule.test

@@ -0,0 +1,49 @@
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.5
+    namespace import -force ::tcltest::*
+}
+
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+testConstraint memorymodule [expr {0 != [tcl::build-info memorymodule]}]
+testConstraint memorymoduletest [expr {0 == [catch {zipfs mount dltest/memorymoduletest.zip [file join [zipfs root] memorymoduletest]}]}]
+
+lappend auto_path [file join [zipfs root] memorymoduletest]
+
+test memorymodule-1.0 {info loaded} memorymoduletest {
+    package require memorymoduletest
+    info loaded {} Memorymoduletest
+} [file join [zipfs root] memorymoduletest/tcl9memorymoduletest.dll]
+
+test memorymodule-1.1 {GetModuleFileNameA (WIP)} {memorymoduletest memorymodule} {
+    package require memorymoduletest
+    GetModuleFileNameA
+} //zipfs:/memorymoduletest/tcl9memorymoduletest.dll
+
+test memorymodule-1.2 {GetModuleFileNameW (WIP)} {memorymoduletest memorymodule} {
+    package require memorymoduletest
+    GetModuleFileNameW
+} //zipfs:/memorymoduletest/tcl9memorymoduletest.dll
+
+test memorymodule-2.0 {LTS} -constraints {memorymoduletest thread} -body {
+    package require Thread
+    package require memorymoduletest
+    set t1 [thread::create]
+    ThreadVar 15; # Set ThreadVar to 15 in the main thread
+    thread::preserve $t1
+    thread::send $t1 {
+	lappend auto_path [file join [zipfs root] memorymoduletest]
+	package require memorymoduletest
+	# set ThreadVar to 16 in the subthread
+	ThreadVar 16
+	return [ThreadVar]
+    } result
+    thread::release $t1
+    # ThreadVar in main thread should be unchanged (15)
+    list [ThreadVar] $result
+} -result {15 16}
+
+
+# cleanup
+::tcltest::cleanupTests
+return
+

unix/tclLoadDyld.c

@@ -546,6 +546,7 @@ TclpLoadMemory(
     Tcl_Size codeSize,	/* Size of code data read into buffer or -1 if
 				 * an error occurred and the buffer should
 				 * just be freed. */
+    TCL_UNUSED(const char *),
     Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
 				 * file which will be passed back to
 				 * (*unloadProcPtr)() to unload the file. */

win/Makefile.in

@@ -547,10 +547,10 @@ ${TCL_ZIP_FILE}:  ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE}
 	@mkdir -p ${TCL_VFS_PATH}
 	@echo "creating ${TCL_VFS_PATH} (prepare compression)"
 	@( \
-	  $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \
-	  $(COPY) -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \
-	  rm -rf ${TCL_VFS_PATH}/dde; \
-	  rm -rf ${TCL_VFS_PATH}/registry; \
+	    $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \
+	    $(COPY) -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \
+	    rm -rf ${TCL_VFS_PATH}/dde; \
+	    rm -rf ${TCL_VFS_PATH}/registry; \
 	)
 	(zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}') 2>/dev/null || \
 	  (echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?")`; \
@@ -671,6 +671,9 @@ tclTestMain.${OBJEXT}: tclAppInit.c
 tclWinInit.${OBJEXT}: tclWinInit.c
 	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
 
+tclWinLoad.${OBJEXT}: tclWinLoad.c
+	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+
 tclWinPipe.${OBJEXT}: tclWinPipe.c
 	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
 
@@ -1019,11 +1022,14 @@ install-private-headers: libraries
 
 test: test-tcl test-packages
 
-test-tcl: tcltest
+test-tcl: tcltest dltest/memorymoduletest.zip
 	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	$(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
 	-load "$(TEST_LOAD_FACILITIES)"
 
+dltest/memorymoduletest.zip:
+	( cd dltest; make; )
+
 # Useful target to launch a built tclsh with the proper path,...
 runtest: tcltest
 	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \