From b21bc1e84f40c6e09c7d3fc3766a4106eab719d8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 24 Apr 2019 14:29:41 +0000
Subject: Plug memleak in [lpop] due to mishandling the unconventional
 recounting practices of TclLsetFlat().

---
 generic/tclCmdIL.c | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index dd7136c..ef7a42c 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2584,7 +2584,7 @@ Tcl_LpopObjCmd(
 				/* Argument objects. */
 {
     int listLen, result;
-    Tcl_Obj *elemPtr;
+    Tcl_Obj *elemPtr, *stored;
     Tcl_Obj *listPtr, **elemPtrs;
 
     if (objc < 2) {
@@ -2622,6 +2622,7 @@ Tcl_LpopObjCmd(
 
     /*
      * Second, remove the element.
+     * TclLsetFlat adds a ref count which is handled.
      */
 
     if (objc == 2) {
@@ -2632,6 +2633,7 @@ Tcl_LpopObjCmd(
 	if (result != TCL_OK) {
 	    return result;
 	}
+	Tcl_IncrRefCount(listPtr);
     } else {
 	listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
 
@@ -2640,8 +2642,9 @@ Tcl_LpopObjCmd(
 	}
     }
 
-    listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
-    if (listPtr == NULL) {
+    stored = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(listPtr);
+    if (stored == NULL) {
 	return TCL_ERROR;
     }
 
-- 
cgit v0.12


From 59a2032b5d7bb96e903eb711f742976d0c7f73db Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 24 Apr 2019 19:29:18 +0000
Subject: Track memory lifetimes in the zip mount/unmount.

---
 generic/tclZipfs.c | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index c3887f0..4f2e43d 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -381,6 +381,7 @@ static int		ZipFSFileAttrsSetProc(Tcl_Interp *interp, int index,
 static int		ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path,
 			    Tcl_LoadHandle *loadHandle,
 			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
+static void		ZipfsExitHandler(ClientData clientData);
 static void		ZipfsSetup(void);
 static int		ZipChannelClose(void *instanceData,
 			    Tcl_Interp *interp);
@@ -1629,6 +1630,8 @@ TclZipfs_Mount(
 {
     ZipFile *zf;
 
+fprintf(stdout, "MOUNT CALLED\n"); fflush(stdout);
+
     ReadLock();
     if (!ZipFS.initialized) {
 	ZipfsSetup();
@@ -1671,16 +1674,20 @@ TclZipfs_Mount(
 	}
     }
     zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
+fprintf(stdout, "ALLOC %p\n", zf); fflush(stdout);
     if (!zf) {
 	if (interp) {
 	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
 	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
 	}
+fprintf(stdout, "MOUNT FAIL A\n"); fflush(stdout);
 	return TCL_ERROR;
     }
     if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
+fprintf(stdout, "MOUNT FAIL B\n"); fflush(stdout);
 	return TCL_ERROR;
     }
+fprintf(stdout, "MOUNT END\n"); fflush(stdout);
     return ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname);
 }
 
@@ -1806,8 +1813,11 @@ TclZipfs_Unmount(
     Tcl_DString dsm;
     int ret = TCL_OK, unmounted = 0;
 
+fprintf(stdout, "UNMOUNT CALLED\n"); fflush(stdout);
     WriteLock();
+fprintf(stdout, "A\n"); fflush(stdout);
     if (!ZipFS.initialized) {
+fprintf(stdout, "NOT INIT\n"); fflush(stdout);
 	goto done;
     }
 
@@ -1816,19 +1826,24 @@ TclZipfs_Unmount(
      * But an absolute name is needed as mount point here.
      */
 
+fprintf(stdout, "B\n"); fflush(stdout);
     Tcl_DStringInit(&dsm);
     mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
 
+fprintf(stdout, "C\n"); fflush(stdout);
     hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
     /* don't report no-such-mount as an error */
     if (!hPtr) {
+fprintf(stdout, "D\n"); fflush(stdout);
 	goto done;
     }
 
+fprintf(stdout, "E\n"); fflush(stdout);
     zf = Tcl_GetHashValue(hPtr);
     if (zf->numOpen > 0) {
 	ZIPFS_ERROR(interp, "filesystem is busy");
 	ret = TCL_ERROR;
+fprintf(stdout, "BUSY\n"); fflush(stdout);
 	goto done;
     }
     Tcl_DeleteHashEntry(hPtr);
@@ -1844,6 +1859,7 @@ TclZipfs_Unmount(
 	ckfree(z);
     }
     ZipFSCloseArchive(interp, zf);
+fprintf(stdout, "FREE %p\n", zf); fflush(stdout);
     ckfree(zf);
     unmounted = 1;
   done:
@@ -4837,6 +4853,18 @@ ZipfsAppHookFindTclInit(
     return TCL_ERROR;
 }
 
+static void
+ZipfsExitHandler(
+    ClientData clientData)
+{
+    char *mountpoint = (char *)clientData;
+
+fprintf(stdout, "UNMOUNT\n"); fflush(stdout);
+    if (TCL_OK != TclZipfs_Unmount(NULL, mountpoint)) {
+	Tcl_Panic("tried to unmount busy filesystem");
+    }
+}
+
 /*
  *-------------------------------------------------------------------------
  *
@@ -4859,19 +4887,26 @@ TclZipfs_AppHook(
 {
     char *archive;
 
+fprintf(stdout, "HOOK CALLED\n"); fflush(stdout);
     Tcl_FindExecutable((*argvPtr)[0]);
+fprintf(stdout, "FOUND\n"); fflush(stdout);
     archive = (char *) Tcl_GetNameOfExecutable();
+fprintf(stdout, "NAME: '%s'\n", archive); fflush(stdout);
     TclZipfs_Init(NULL);
+fprintf(stdout, "INIT\n"); fflush(stdout);
 
     /*
      * Look for init.tcl in one of the locations mounted later in this
      * function.
      */
+fprintf(stdout, "START\n"); fflush(stdout);
 
     if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
 	int found;
 	Tcl_Obj *vfsInitScript;
 
+fprintf(stdout, "MOUNTED\n"); fflush(stdout);
+
 	TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	Tcl_IncrRefCount(vfsInitScript);
 	if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
@@ -4960,6 +4995,9 @@ TclZipfs_AppHook(
 #endif /* _WIN32 */
 #endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
     }
+fprintf(stdout, "HANDLE\n"); fflush(stdout);
+    Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)ZIPFS_APP_MOUNT);
+fprintf(stdout, "END\n"); fflush(stdout);
     return TCL_OK;
 }
 
-- 
cgit v0.12


From b3676ba87cb737e7954dd8c6ad6515ae6a872674 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 29 Apr 2019 19:26:40 +0000
Subject: more WIP

---
 generic/tclZipfs.c | 24 +++++++++++++++++++++---
 1 file changed, 21 insertions(+), 3 deletions(-)

diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 4f2e43d..0fd65a4 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -997,6 +997,7 @@ ZipFSFindTOC(
 	if (interp) {
 	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "END_SIG", NULL);
 	}
+fprintf(stdout, "TOC FAIL 1\n"); fflush(stdout);
 	goto error;
     }
     zf->numFiles = ZipReadShort(p + ZIP_CENTRAL_ENTS_OFFS);
@@ -1009,6 +1010,7 @@ ZipFSFindTOC(
 	if (interp) {
 	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
 	}
+fprintf(stdout, "TOC FAIL 2\n"); fflush(stdout);
 	goto error;
     }
     q = zf->data + ZipReadInt(p + ZIP_CENTRAL_DIRSTART_OFFS);
@@ -1023,6 +1025,7 @@ ZipFSFindTOC(
 	if (interp) {
 	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_DIR", NULL);
 	}
+fprintf(stdout, "TOC FAIL 3\n"); fflush(stdout);
 	goto error;
     }
     zf->baseOffset = zf->passOffset = p - q;
@@ -1036,6 +1039,7 @@ ZipFSFindTOC(
 	    if (interp) {
 		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_LEN", NULL);
 	    }
+fprintf(stdout, "TOC FAIL 4\n"); fflush(stdout);
 	    goto error;
 	}
 	if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
@@ -1043,6 +1047,7 @@ ZipFSFindTOC(
 	    if (interp) {
 		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_SIG", NULL);
 	    }
+fprintf(stdout, "TOC FAIL 5\n"); fflush(stdout);
 	    goto error;
 	}
 	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
@@ -1113,6 +1118,7 @@ ZipFSOpenArchive(
     zf->passBuf[0] = 0;
     zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0);
     if (!zf->chan) {
+fprintf(stdout, "OA FAIL 1\n"); fflush(stdout);
 	return TCL_ERROR;
     }
     if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {
@@ -1189,10 +1195,12 @@ ZipFSOpenArchive(
 	}
 #endif /* _WIN32 */
     }
+fprintf(stdout, "OA END\n"); fflush(stdout);
     return ZipFSFindTOC(interp, needZip, zf);
 
   error:
     ZipFSCloseArchive(interp, zf);
+fprintf(stdout, "OA FAIL 2\n"); fflush(stdout);
     return TCL_ERROR;
 }
 
@@ -1685,10 +1693,18 @@ fprintf(stdout, "MOUNT FAIL A\n"); fflush(stdout);
     }
     if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
 fprintf(stdout, "MOUNT FAIL B\n"); fflush(stdout);
+	ckfree(zf);
+	return TCL_ERROR;
+    }
+    if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname)
+	    != TCL_OK) {
+fprintf(stdout, "MOUNT FAIL C\n"); fflush(stdout);
+	ckfree(zf);
 	return TCL_ERROR;
     }
 fprintf(stdout, "MOUNT END\n"); fflush(stdout);
-    return ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname);
+    Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)mountPoint);
+    return TCL_OK;
 }
 
 /*
@@ -4907,6 +4923,8 @@ fprintf(stdout, "START\n"); fflush(stdout);
 
 fprintf(stdout, "MOUNTED\n"); fflush(stdout);
 
+//	Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)ZIPFS_APP_MOUNT);
+
 	TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	Tcl_IncrRefCount(vfsInitScript);
 	if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
@@ -4968,6 +4986,8 @@ fprintf(stdout, "MOUNTED\n"); fflush(stdout);
 	    int found;
 	    Tcl_Obj *vfsInitScript;
 
+//	    Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)ZIPFS_APP_MOUNT);
+
 	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
@@ -4995,8 +5015,6 @@ fprintf(stdout, "MOUNTED\n"); fflush(stdout);
 #endif /* _WIN32 */
 #endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
     }
-fprintf(stdout, "HANDLE\n"); fflush(stdout);
-    Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)ZIPFS_APP_MOUNT);
 fprintf(stdout, "END\n"); fflush(stdout);
     return TCL_OK;
 }
-- 
cgit v0.12


From 89c677d626e30f3439e20b018fc86d1f5f0c3246 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Wed, 1 May 2019 10:44:10 +0000
Subject: Check for BG_FLUSH_SCHEDULED inside ChannelTimerProc

---
 generic/tclIO.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 4775820..118820a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8511,7 +8511,7 @@ UpdateInterest(
 	}
     }
 
-    if (statePtr->timer == NULL
+    if (!statePtr->timer
 	&& mask & TCL_WRITABLE
 	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 
@@ -8551,7 +8551,9 @@ ChannelTimerProc(
     Tcl_Preserve(statePtr);
     statePtr->timer = NULL;
     if (statePtr->interestMask & TCL_WRITABLE
-	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
+	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
+	&& !GotFlag(statePtr, BG_FLUSH_SCHEDULED)
+	) {
 	/*
 	 * Restart the timer in case a channel handler reenters the event loop
 	 * before UpdateInterest gets called by Tcl_NotifyChannel.
-- 
cgit v0.12


From d1faa9b2b18b2357320288e318922ba2522289e6 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 1 May 2019 13:52:26 +0000
Subject: now testing....

---
 generic/tclZipfs.c | 44 +++++---------------------------------------
 1 file changed, 5 insertions(+), 39 deletions(-)

diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 0fd65a4..340aa91 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -997,7 +997,6 @@ ZipFSFindTOC(
 	if (interp) {
 	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "END_SIG", NULL);
 	}
-fprintf(stdout, "TOC FAIL 1\n"); fflush(stdout);
 	goto error;
     }
     zf->numFiles = ZipReadShort(p + ZIP_CENTRAL_ENTS_OFFS);
@@ -1010,7 +1009,6 @@ fprintf(stdout, "TOC FAIL 1\n"); fflush(stdout);
 	if (interp) {
 	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
 	}
-fprintf(stdout, "TOC FAIL 2\n"); fflush(stdout);
 	goto error;
     }
     q = zf->data + ZipReadInt(p + ZIP_CENTRAL_DIRSTART_OFFS);
@@ -1025,7 +1023,6 @@ fprintf(stdout, "TOC FAIL 2\n"); fflush(stdout);
 	if (interp) {
 	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_DIR", NULL);
 	}
-fprintf(stdout, "TOC FAIL 3\n"); fflush(stdout);
 	goto error;
     }
     zf->baseOffset = zf->passOffset = p - q;
@@ -1039,7 +1036,6 @@ fprintf(stdout, "TOC FAIL 3\n"); fflush(stdout);
 	    if (interp) {
 		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_LEN", NULL);
 	    }
-fprintf(stdout, "TOC FAIL 4\n"); fflush(stdout);
 	    goto error;
 	}
 	if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
@@ -1047,7 +1043,6 @@ fprintf(stdout, "TOC FAIL 4\n"); fflush(stdout);
 	    if (interp) {
 		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_SIG", NULL);
 	    }
-fprintf(stdout, "TOC FAIL 5\n"); fflush(stdout);
 	    goto error;
 	}
 	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
@@ -1118,7 +1113,6 @@ ZipFSOpenArchive(
     zf->passBuf[0] = 0;
     zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0);
     if (!zf->chan) {
-fprintf(stdout, "OA FAIL 1\n"); fflush(stdout);
 	return TCL_ERROR;
     }
     if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {
@@ -1195,12 +1189,10 @@ fprintf(stdout, "OA FAIL 1\n"); fflush(stdout);
 	}
 #endif /* _WIN32 */
     }
-fprintf(stdout, "OA END\n"); fflush(stdout);
     return ZipFSFindTOC(interp, needZip, zf);
 
   error:
     ZipFSCloseArchive(interp, zf);
-fprintf(stdout, "OA FAIL 2\n"); fflush(stdout);
     return TCL_ERROR;
 }
 
@@ -1295,6 +1287,7 @@ ZipFSCatalogFilesystem(
 
     *zf = *zf0;
     zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
+    Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)zf);
     zf->mountPointLen = strlen(zf->mountPoint);
     zf->nameLength = strlen(zipname);
     zf->name = ckalloc(zf->nameLength + 1);
@@ -1638,8 +1631,6 @@ TclZipfs_Mount(
 {
     ZipFile *zf;
 
-fprintf(stdout, "MOUNT CALLED\n"); fflush(stdout);
-
     ReadLock();
     if (!ZipFS.initialized) {
 	ZipfsSetup();
@@ -1682,28 +1673,23 @@ fprintf(stdout, "MOUNT CALLED\n"); fflush(stdout);
 	}
     }
     zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
-fprintf(stdout, "ALLOC %p\n", zf); fflush(stdout);
     if (!zf) {
 	if (interp) {
 	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
 	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
 	}
-fprintf(stdout, "MOUNT FAIL A\n"); fflush(stdout);
 	return TCL_ERROR;
     }
     if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
-fprintf(stdout, "MOUNT FAIL B\n"); fflush(stdout);
 	ckfree(zf);
 	return TCL_ERROR;
     }
     if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname)
 	    != TCL_OK) {
-fprintf(stdout, "MOUNT FAIL C\n"); fflush(stdout);
 	ckfree(zf);
 	return TCL_ERROR;
     }
-fprintf(stdout, "MOUNT END\n"); fflush(stdout);
-    Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)mountPoint);
+    ckfree(zf);
     return TCL_OK;
 }
 
@@ -1829,11 +1815,8 @@ TclZipfs_Unmount(
     Tcl_DString dsm;
     int ret = TCL_OK, unmounted = 0;
 
-fprintf(stdout, "UNMOUNT CALLED\n"); fflush(stdout);
     WriteLock();
-fprintf(stdout, "A\n"); fflush(stdout);
     if (!ZipFS.initialized) {
-fprintf(stdout, "NOT INIT\n"); fflush(stdout);
 	goto done;
     }
 
@@ -1842,24 +1825,19 @@ fprintf(stdout, "NOT INIT\n"); fflush(stdout);
      * But an absolute name is needed as mount point here.
      */
 
-fprintf(stdout, "B\n"); fflush(stdout);
     Tcl_DStringInit(&dsm);
     mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
 
-fprintf(stdout, "C\n"); fflush(stdout);
     hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
     /* don't report no-such-mount as an error */
     if (!hPtr) {
-fprintf(stdout, "D\n"); fflush(stdout);
 	goto done;
     }
 
-fprintf(stdout, "E\n"); fflush(stdout);
     zf = Tcl_GetHashValue(hPtr);
     if (zf->numOpen > 0) {
 	ZIPFS_ERROR(interp, "filesystem is busy");
 	ret = TCL_ERROR;
-fprintf(stdout, "BUSY\n"); fflush(stdout);
 	goto done;
     }
     Tcl_DeleteHashEntry(hPtr);
@@ -1875,7 +1853,7 @@ fprintf(stdout, "BUSY\n"); fflush(stdout);
 	ckfree(z);
     }
     ZipFSCloseArchive(interp, zf);
-fprintf(stdout, "FREE %p\n", zf); fflush(stdout);
+    Tcl_DeleteExitHandler(ZipfsExitHandler, (ClientData)zf);
     ckfree(zf);
     unmounted = 1;
   done:
@@ -4873,10 +4851,9 @@ static void
 ZipfsExitHandler(
     ClientData clientData)
 {
-    char *mountpoint = (char *)clientData;
+    ZipFile *zf = (ZipFile *)clientData;
 
-fprintf(stdout, "UNMOUNT\n"); fflush(stdout);
-    if (TCL_OK != TclZipfs_Unmount(NULL, mountpoint)) {
+    if (TCL_OK != TclZipfs_Unmount(NULL, zf->mountPoint)) {
 	Tcl_Panic("tried to unmount busy filesystem");
     }
 }
@@ -4903,27 +4880,19 @@ TclZipfs_AppHook(
 {
     char *archive;
 
-fprintf(stdout, "HOOK CALLED\n"); fflush(stdout);
     Tcl_FindExecutable((*argvPtr)[0]);
-fprintf(stdout, "FOUND\n"); fflush(stdout);
     archive = (char *) Tcl_GetNameOfExecutable();
-fprintf(stdout, "NAME: '%s'\n", archive); fflush(stdout);
     TclZipfs_Init(NULL);
-fprintf(stdout, "INIT\n"); fflush(stdout);
 
     /*
      * Look for init.tcl in one of the locations mounted later in this
      * function.
      */
-fprintf(stdout, "START\n"); fflush(stdout);
 
     if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
 	int found;
 	Tcl_Obj *vfsInitScript;
 
-fprintf(stdout, "MOUNTED\n"); fflush(stdout);
-
-//	Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)ZIPFS_APP_MOUNT);
 
 	TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	Tcl_IncrRefCount(vfsInitScript);
@@ -4986,8 +4955,6 @@ fprintf(stdout, "MOUNTED\n"); fflush(stdout);
 	    int found;
 	    Tcl_Obj *vfsInitScript;
 
-//	    Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)ZIPFS_APP_MOUNT);
-
 	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
@@ -5015,7 +4982,6 @@ fprintf(stdout, "MOUNTED\n"); fflush(stdout);
 #endif /* _WIN32 */
 #endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
     }
-fprintf(stdout, "END\n"); fflush(stdout);
     return TCL_OK;
 }
 
-- 
cgit v0.12


From 057bc4e6404514a4256888ccfa1fa139e5276057 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 1 May 2019 14:25:40 +0000
Subject: duplicate test names

---
 tests/dict.test | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/dict.test b/tests/dict.test
index 62590e7..e5284fc 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -2128,7 +2128,7 @@ test dict-27.8 {dict getwithdefault command} -returnCodes error -body {
 test dict-27.9 {dict getwithdefault command} -returnCodes error -body {
     dict getwithdefault {} {}
 } -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
-test dict-26.10 {dict getdef command} -returnCodes error -body {
+test dict-27.10 {dict getdef command} -returnCodes error -body {
     dict getwithdefault {a b c} d e
 } -result {missing value to go with key}
 test dict-27.11 {dict getwithdefault command} -body {
@@ -2149,7 +2149,7 @@ test dict-27.15 {dict getwithdefault command} -body {
 test dict-27.16 {dict getwithdefault command} -returnCodes error -body {
     $dict getwithdefault {a {b c d}} a b d
 } -result {missing value to go with key}
-test dict-26.17 {dict getdef command} -returnCodes error -body {
+test dict-27.17 {dict getdef command} -returnCodes error -body {
     $dict getwithdefault {a b c} d e
 } -result {missing value to go with key}
 
-- 
cgit v0.12


From 915cd6b66789a552437299e9047e9997c61461ca Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 1 May 2019 22:37:36 +0000
Subject: WIP

---
 generic/tclInt.h    |  1 +
 generic/tclLink.c   | 12 ++++++++++++
 generic/tclNamesp.c |  7 +++++++
 3 files changed, 20 insertions(+)

diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3db1264..ed087fe 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3105,6 +3105,7 @@ MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
 MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
 MODULE_SCOPE int	TclNokia770Doubles(void);
 MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
+MODULE_SCOPE int	TclNamespaceDeleted(Tcl_Namespace *nsPtr);
 MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 			    Tcl_Obj *part2Ptr, const char *operation,
 			    const char *reason, int index);
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 8096c25..1ebfe6a 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -27,6 +27,7 @@
 
 typedef struct Link {
     Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
+    Tcl_Namespace *nsPtr;	/* Namespace containing Tcl variable */
     Tcl_Obj *varName;		/* Name of variable (must be global). This is
 				 * needed during trace callbacks, since the
 				 * actual variable may be aliased at that time
@@ -170,6 +171,7 @@ Tcl_LinkVar(
 
     linkPtr = ckalloc(sizeof(Link));
     linkPtr->interp = interp;
+    linkPtr->nsPtr = NULL;
     linkPtr->varName = Tcl_NewStringObj(varName, -1);
     Tcl_IncrRefCount(linkPtr->varName);
     linkPtr->addr = addr;
@@ -196,6 +198,11 @@ Tcl_LinkVar(
 	LinkFree(linkPtr);
 	return TCL_ERROR;
     }
+
+    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
+	    &(linkPtr->nsPtr),
+
+
     code = Tcl_TraceVar2(interp, varName, NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    LinkTraceProc, linkPtr);
@@ -362,6 +369,8 @@ Tcl_LinkArray(
     linkPtr->interp = interp;
     linkPtr->varName = Tcl_NewStringObj(varName, -1);
     Tcl_IncrRefCount(linkPtr->varName);
+
+
     objPtr = ObjValue(linkPtr);
     if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
 	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
@@ -1497,6 +1506,9 @@ static void
 LinkFree(
     Link *linkPtr)		/* Structure describing linked variable. */
 {
+    if (linkPtr->nsPtr) {
+	TclNsDecrRefCount((Namespace *)(linkPtr->nsPtr));
+    }
     if (linkPtr->flags & LINK_ALLOC_ADDR) {
 	ckfree(linkPtr->addr);
     }
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index b553880..7e18568 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1086,6 +1086,13 @@ Tcl_DeleteNamespace(
     }
     TclNsDecrRefCount(nsPtr);
 }
+
+int
+TclNamespaceDeleted(
+    Tcl_Namespace *nsPtr)
+{
+    return (((Namespace *) nsPtr)->flags & NS_DYING) ? 1 : 0;
+}
 
 /*
  *----------------------------------------------------------------------
-- 
cgit v0.12


From 7a0e892768a898897815256772a48fe456fb9e62 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 3 May 2019 14:57:04 +0000
Subject: leak plug completed

---
 generic/tclInt.h  |  2 +-
 generic/tclLink.c | 17 ++++++++++++-----
 2 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/generic/tclInt.h b/generic/tclInt.h
index ed087fe..8453fba 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3105,7 +3105,7 @@ MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
 MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
 MODULE_SCOPE int	TclNokia770Doubles(void);
 MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
-MODULE_SCOPE int	TclNamespaceDeleted(Tcl_Namespace *nsPtr);
+MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
 MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 			    Tcl_Obj *part2Ptr, const char *operation,
 			    const char *reason, int index);
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 1ebfe6a..3bcfb72 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -27,7 +27,7 @@
 
 typedef struct Link {
     Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
-    Tcl_Namespace *nsPtr;	/* Namespace containing Tcl variable */
+    Namespace *nsPtr;		/* Namespace containing Tcl variable */
     Tcl_Obj *varName;		/* Name of variable (must be global). This is
 				 * needed during trace callbacks, since the
 				 * actual variable may be aliased at that time
@@ -159,6 +159,8 @@ Tcl_LinkVar(
 {
     Tcl_Obj *objPtr;
     Link *linkPtr;
+    Namespace *dummy;
+    const char *name;
     int code;
 
     linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
@@ -200,8 +202,8 @@ Tcl_LinkVar(
     }
 
     TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
-	    &(linkPtr->nsPtr),
-
+	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
+    linkPtr->nsPtr->refCount++;
 
     code = Tcl_TraceVar2(interp, varName, NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
@@ -247,6 +249,8 @@ Tcl_LinkArray(
 {
     Tcl_Obj *objPtr;
     Link *linkPtr;
+    Namespace *dummy;
+    const char *name;
     int code;
 
     if (size < 1) {
@@ -370,6 +374,9 @@ Tcl_LinkArray(
     linkPtr->varName = Tcl_NewStringObj(varName, -1);
     Tcl_IncrRefCount(linkPtr->varName);
 
+    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
+	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
+    linkPtr->nsPtr->refCount++;
 
     objPtr = ObjValue(linkPtr);
     if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
@@ -756,7 +763,7 @@ LinkTraceProc(
      */
 
     if (flags & TCL_TRACE_UNSETS) {
-	if (Tcl_InterpDeleted(interp)) {
+	if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) {
 	    Tcl_DecrRefCount(linkPtr->varName);
 	    LinkFree(linkPtr);
 	} else if (flags & TCL_TRACE_DESTROYED) {
@@ -1507,7 +1514,7 @@ LinkFree(
     Link *linkPtr)		/* Structure describing linked variable. */
 {
     if (linkPtr->nsPtr) {
-	TclNsDecrRefCount((Namespace *)(linkPtr->nsPtr));
+	TclNsDecrRefCount(linkPtr->nsPtr);
     }
     if (linkPtr->flags & LINK_ALLOC_ADDR) {
 	ckfree(linkPtr->addr);
-- 
cgit v0.12


From 8510dda2accfa5d28aadbf328145c295db975815 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 3 May 2019 15:15:21 +0000
Subject: missed bit of type revision.

---
 generic/tclNamesp.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 7e18568..bbe357d 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1089,9 +1089,9 @@ Tcl_DeleteNamespace(
 
 int
 TclNamespaceDeleted(
-    Tcl_Namespace *nsPtr)
+    Namespace *nsPtr)
 {
-    return (((Namespace *) nsPtr)->flags & NS_DYING) ? 1 : 0;
+    return (nsPtr->flags & NS_DYING) ? 1 : 0;
 }
 
 /*
-- 
cgit v0.12