Index: generic/tclBasic.c
===================================================================
--- generic/tclBasic.c
+++ generic/tclBasic.c
@@ -1357,11 +1357,11 @@
     /*
      * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
 	 * unless we are exiting.
      */
 
-    if ((iPtr->numLevels > 0) && !TclInExit()) {
+    if ((iPtr->numLevels > 0) && !TclInExit() && !(((Interp *)interp)->flags & 0x4000)) {
 	Tcl_Panic("DeleteInterpProc called with active evals");
     }
 
     /*
      * The interpreter should already be marked deleted; otherwise how did we
@@ -1480,11 +1480,11 @@
     /*
      * Pop the root frame pointer and finish deleting the global
      * namespace. The order is important [Bug 1658572].
      */
 
-    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
+    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit() && !(iPtr->flags & 0x4000)) {
 	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
     }
     Tcl_PopCallFrame(interp);
     ckfree(iPtr->rootFramePtr);
     iPtr->rootFramePtr = NULL;
@@ -1601,11 +1601,11 @@
      * Location stack for uplevel/eval/... scripts which were passed through
      * proc arguments. Actually we track all arguments as we do not and cannot
      * know which arguments will be used as scripts and which will not.
      */
 
-    if (iPtr->lineLAPtr->numEntries && !TclInExit()) {
+    if (iPtr->lineLAPtr->numEntries && !TclInExit() && !(iPtr->flags & 0x4000)) {
 	/*
 	 * When the interp goes away we have nothing on the stack, so there
 	 * are no arguments, so this table has to be empty.
 	 */
 
@@ -1614,11 +1614,11 @@
 
     Tcl_DeleteHashTable(iPtr->lineLAPtr);
     ckfree((char *) iPtr->lineLAPtr);
     iPtr->lineLAPtr = NULL;
 
-    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
+    if (iPtr->lineLABCPtr->numEntries && !TclInExit() && !(iPtr->flags & 0x4000)) {
 	/*
 	 * When the interp goes away we have nothing on the stack, so there
 	 * are no arguments, so this table has to be empty.
 	 */
 

Index: generic/tclExecute.c
===================================================================
--- generic/tclExecute.c
+++ generic/tclExecute.c
@@ -898,11 +898,11 @@
 DeleteExecStack(
     ExecStack *esPtr)
 {
     if (esPtr->markerPtr && !cachedInExit) {
 	Tcl_Panic("freeing an execStack which is still in use");
-    }
+}
 
     if (esPtr->prevPtr) {
 	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
     }
     if (esPtr->nextPtr) {
@@ -915,11 +915,11 @@
 TclDeleteExecEnv(
     ExecEnv *eePtr)		/* Execution environment to free. */
 {
     ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
 
-	cachedInExit = TclInExit();
+    cachedInExit = 1; // TclInExit();
 
     /*
      * Delete all stacks in this exec env.
      */
 

Index: generic/tclThreadTest.c
===================================================================
--- generic/tclThreadTest.c
+++ generic/tclThreadTest.c
@@ -175,10 +175,30 @@
     return TCL_OK;
 }
 
 
 /*
+ * ThreadEnd --
+ *
+ *  This function does all the necessary cleanup of the thread+interp+tsd.
+ *  To be called either in normal fallthrough or testthead::exit.
+ */
+
+static void ThreadEnd(
+		      int status,
+		      ThreadSpecificData *tsdPtr,
+		      int hack)
+{
+    ((Interp *)tsdPtr->interp)->flags |= 0x4000;
+    ListRemove(hack ? NULL: tsdPtr);
+    Tcl_Release(tsdPtr->interp);
+    Tcl_DeleteInterp(tsdPtr->interp);
+    Tcl_ExitThread(status);
+}
+
+
+/*
  *----------------------------------------------------------------------
  *
  * ThreadObjCmd --
  *
  *	This procedure is invoked to process the "testthread" Tcl command. See
@@ -323,12 +343,11 @@
     case THREAD_EXIT:
 	if (objc > 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
 	}
-	ListRemove(NULL);
-	Tcl_ExitThread(0);
+	ThreadEnd(0, tsdPtr, 1);
 	return TCL_OK;
     case THREAD_ID:
 	if (objc == 2 || objc == 3) {
 	    Tcl_Obj *idObj;
 
@@ -621,14 +640,11 @@
 
     /*
      * Clean up.
      */
 
-    ListRemove(tsdPtr);
-    Tcl_Release(tsdPtr->interp);
-    Tcl_DeleteInterp(tsdPtr->interp);
-    Tcl_ExitThread(result);
+    ThreadEnd(result, tsdPtr, 0);
 
     TCL_THREAD_CREATE_RETURN;
 }
 
 /*

Index: library/tcltest/tcltest.tcl
===================================================================
--- library/tcltest/tcltest.tcl
+++ library/tcltest/tcltest.tcl
@@ -3283,10 +3283,11 @@
 	    foreach tid [testthread names] {
 		if {$tid != [mainThread]} {
 		    catch {
 			testthread send -async $tid {testthread exit}
 		    }
+		    testthread join $tid
 		}
 	    }
 	    ## Enter a bit a sleep to give the threads enough breathing
 	    ## room to kill themselves off, otherwise the end up with a
 	    ## massive queue of repeated events

Index: tests/socket.test
===================================================================
--- tests/socket.test
+++ tests/socket.test
@@ -1,5 +1,9 @@
+if {[llength [info commands memory]]} {
+    memory onexit /tmp/mem[pid].log
+}
+
 # Commands tested in this file: socket.
 #
 # 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.
@@ -1699,11 +1703,11 @@
         # thread cleans itself up.
         testthread exit
     }] script]
 } -constraints [list socket supported_$af testthread] -body {
     # create a thread
-    set serverthread [testthread create [list source $path(script) ] ]
+    set serverthread [testthread create -joinable [list source $path(script) ] ]
     update
     set port [testthread send $serverthread {set listen}]
     update
     set s [socket $localhost $port]
     fconfigure $s -buffering line

