Replace logical and with bitwise &

Still has several memleaks.

doc/namespace.n

@@ -80,13 +80,10 @@ as a convenience to programmers.
 .TP
 \fBnamespace delete \fR?\fInamespace namespace ...\fR?
 .
-Each namespace \fInamespace\fR is deleted
-and all variables, procedures, and child namespaces
-contained in the namespace are deleted.
-If a procedure is currently executing inside the namespace,
-the namespace will be kept alive until the procedure returns;
-however, the namespace is marked to prevent other code from
-looking it up by name.
+Each namespace \fInamespace\fR is deleted and its ensemble commands, child
+namespaces, commands, and variables are deleted in that order. Any evaluation
+levels using the namespace as the current namespace then use the global
+namespace instead.
 If a namespace does not exist, this command returns an error.
 If no namespace names are given, this command does nothing.
 .TP

generic/tcl.h

@@ -890,6 +890,7 @@ typedef struct Tcl_CallFrame {
     void *dummy11;
     void *dummy12;
     void *dummy13;
+    void *dummy14;
 } Tcl_CallFrame;
 
 /*

generic/tclBasic.c

@@ -861,7 +861,7 @@ Tcl_CreateInterp(void)
      * cache was already initialised by the call to alloc the interp struct.
      */
 
-#if TCL_THREADS && defined(USE_THREAD_ALLOC)
+#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(USE_THREAD_ALLOC)
     iPtr->allocCache = TclpGetAllocCache();
 #else
     iPtr->allocCache = NULL;
@@ -894,6 +894,7 @@ Tcl_CreateInterp(void)
 	    cmdPtr = ckalloc(sizeof(Command));
 	    cmdPtr->hPtr = hPtr;
 	    cmdPtr->nsPtr = iPtr->globalNsPtr;
+	    iPtr->globalNsPtr->refCount++;
 	    cmdPtr->refCount = 1;
 	    cmdPtr->cmdEpoch = 0;
 	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
@@ -1076,7 +1077,7 @@ Tcl_CreateInterp(void)
 #endif /* !TCL_NO_DEPRECATED */
     TclpSetVariables(interp);
 
-#if TCL_THREADS
+#if !defined(TCL_THREADS) || TCL_THREADS
     /*
      * The existence of the "threaded" element of the tcl_platform array
      * indicates that this particular Tcl shell has been compiled with threads
@@ -1716,7 +1717,7 @@ DeleteInterpProc(
      */
 
     TclHandleFree(iPtr->handle);
-    TclTeardownNamespace(iPtr->globalNsPtr);
+    Tcl_DeleteNamespace((Tcl_Namespace *)iPtr->globalNsPtr);
 
     /*
      * Delete all the hidden commands.
@@ -1763,18 +1764,12 @@ DeleteInterpProc(
 	ckfree(hTablePtr);
     }
 
-    /*
-     * Pop the root frame pointer and finish deleting the global
-     * namespace. The order is important [Bug 1658572].
-     */
-
     if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
 	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
     }
     Tcl_PopCallFrame(interp);
     ckfree(iPtr->rootFramePtr);
     iPtr->rootFramePtr = NULL;
-    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
 
     /*
      * Free up the result *after* deleting variables, since variable deletion
@@ -2429,6 +2424,7 @@ Tcl_CreateCommand(
     Tcl_SetHashValue(hPtr, cmdPtr);
     cmdPtr->hPtr = hPtr;
     cmdPtr->nsPtr = nsPtr;
+    nsPtr->refCount++;
     cmdPtr->refCount = 1;
     cmdPtr->cmdEpoch = 0;
     cmdPtr->compileProc = NULL;
@@ -2627,6 +2623,7 @@ TclCreateObjCommandInNs(
 	cmdPtr->nsPtr->refCount++;
 
 	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+
 	nsPtr = (Namespace *) TclEnsureNamespace(interp,
                 (Tcl_Namespace *) cmdPtr->nsPtr);
 	TclNsDecrRefCount(cmdPtr->nsPtr);
@@ -2674,6 +2671,7 @@ TclCreateObjCommandInNs(
     Tcl_SetHashValue(hPtr, cmdPtr);
     cmdPtr->hPtr = hPtr;
     cmdPtr->nsPtr = nsPtr;
+    nsPtr->refCount++;
     cmdPtr->refCount = 1;
     cmdPtr->cmdEpoch = 0;
     cmdPtr->compileProc = NULL;
@@ -2959,8 +2957,12 @@ TclRenameCommand(
     if (result != TCL_OK) {
 	Tcl_DeleteHashEntry(cmdPtr->hPtr);
 	cmdPtr->hPtr = oldHPtr;
+	/* reference count was already incremented above */
 	cmdPtr->nsPtr = cmdNsPtr;
 	goto done;
+    } else {
+	cmdPtr->nsPtr->refCount++;
+	TclNsDecrRefCount(cmdNsPtr);
     }
 
     /*
@@ -3417,8 +3419,6 @@ Tcl_DeleteCommandFromToken(
      * traces.
      */
 
-    cmdPtr->nsPtr->refCount++;
-
     if (cmdPtr->tracePtr != NULL) {
 	CommandTrace *tracePtr;
 	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
@@ -3446,7 +3446,6 @@ Tcl_DeleteCommandFromToken(
      */
 
     TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
-    TclNsDecrRefCount(cmdPtr->nsPtr);
 
     /*
      * If the command being deleted has a compile function, increment the
@@ -3531,6 +3530,7 @@ Tcl_DeleteCommandFromToken(
      * TclNRExecuteByteCode looks up the command in the command hashtable).
      */
 
+    TclNsDecrRefCount(cmdPtr->nsPtr);
     TclCleanupCommandMacro(cmdPtr);
     return 0;
 }
@@ -4519,7 +4519,7 @@ static int
 EvalObjvCore(
     ClientData data[],
     Tcl_Interp *interp,
-    int result)
+    int result)		    /* ignored */
 {
     Command *cmdPtr = NULL, *preCmdPtr = data[0];
     int flags = PTR2INT(data[1]);
@@ -4528,6 +4528,7 @@ EvalObjvCore(
     Interp *iPtr = (Interp *) interp;
     Namespace *lookupNsPtr = NULL;
     int enterTracesDone = 0;
+    result = TCL_OK;
 
     /*
      * Push records for task to be done on return, in INVERSE order. First, if
@@ -4570,6 +4571,7 @@ EvalObjvCore(
 	iPtr->lookupNsPtr = NULL;
     } else if (flags & TCL_EVAL_INVOKE) {
 	lookupNsPtr = iPtr->globalNsPtr;
+	lookupNsPtr->refCount++;
     } else {
 
 	/*
@@ -4581,6 +4583,7 @@ EvalObjvCore(
 	if (flags & TCL_EVAL_GLOBAL) {
 	    TEOV_SwitchVarFrame(interp);
 	    lookupNsPtr = iPtr->globalNsPtr;
+	    lookupNsPtr->refCount++;
 	}
     }
 
@@ -4603,13 +4606,15 @@ EvalObjvCore(
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "attempt to invoke a deleted command"));
 	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
-	    return TCL_ERROR;
+	    result = TCL_ERROR;
+	    goto cleanup;
 	}
     }
     if (cmdPtr == NULL) {
 	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
 	if (!cmdPtr) {
-	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+	    result = TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+	    goto cleanup;
 	}
     }
 
@@ -4623,7 +4628,7 @@ EvalObjvCore(
 
 	if (!enterTracesDone) {
 
-	    int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
+	    result = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
 		    objc, objv);
 
 	    /*
@@ -4636,9 +4641,9 @@ EvalObjvCore(
 	     * problem of permanently hiding program errors.)
 	     */
 
-	    if (code != TCL_OK) {
+	    if (result != TCL_OK) {
 		Tcl_DecrRefCount(commandPtr);
-		return code;
+		goto cleanup;
 	    }
 
 	    /*
@@ -4668,7 +4673,14 @@ EvalObjvCore(
     TclNRAddCallback(interp, Dispatch,
 	    cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc,
 	    cmdPtr->objClientData, INT2PTR(objc), objv);
-    return TCL_OK;
+
+cleanup:
+
+    if (lookupNsPtr) {
+	TclNsDecrRefCount(lookupNsPtr);
+    }
+
+    return result;
 }
 
 static int
@@ -4773,7 +4785,7 @@ NRCommand(
       */
 
     if (data[1] && (data[1] != INT2PTR(1))) {
-        TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
+        TclNRAddCallback(interp, TclNRTailcallEval, data[1], data[2], NULL, NULL);
     }
 
     /* OPT ??
@@ -5016,6 +5028,8 @@ TEOV_NotFound(
     if (lookupNsPtr) {
 	savedNsPtr = varFramePtr->nsPtr;
 	varFramePtr->nsPtr = lookupNsPtr;
+	/* Corresponding TclNsDecrRefCount is in TEOV_NotFoundCallback. */
+	varFramePtr->nsPtr->refCount++;
     }
     TclSkipTailcall(interp);
     TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
@@ -5037,6 +5051,7 @@ TEOV_NotFoundCallback(
     int i;
 
     if (savedNsPtr) {
+	TclNsDecrRefCount(iPtr->varFramePtr->nsPtr);
 	iPtr->varFramePtr->nsPtr = savedNsPtr;
     }
 
@@ -8615,7 +8630,9 @@ TclPushTailcallPoint(
 void
 TclSetTailcall(
     Tcl_Interp *interp,
-    Tcl_Obj *listPtr)
+    Namespace *nsPtr,
+    Tcl_Obj *listPtr
+    )
 {
     /*
      * Find the splicing spot: right before the NRCommand of the thing
@@ -8634,6 +8651,9 @@ TclSetTailcall(
         Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
     }
     runPtr->data[1] = listPtr;
+    runPtr->data[2] = nsPtr;
+    /* Corresponding TclNsDecrRefCount is in EvalObjvCore */
+    nsPtr->refCount++;
 }
 
 /*
@@ -8678,29 +8698,23 @@ TclNRTailcallObjCmd(
      * with an argument replaces any previously scheduled tailcall.
      */
 
-    if (iPtr->varFramePtr->tailcallPtr) {
-        Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
-        iPtr->varFramePtr->tailcallPtr = NULL;
+    if (iPtr->varFramePtr->tailcallNsPtr) {
+        TclNsDecrRefCount(iPtr->varFramePtr->tailcallNsPtr);
+        iPtr->varFramePtr->tailcallNsPtr = NULL;
+        Tcl_DecrRefCount(iPtr->varFramePtr->tailcallCmdPtr);
+        iPtr->varFramePtr->tailcallCmdPtr = NULL;
     }
 
     /*
      * Create the callback to actually evaluate the tailcalled
-     * command, then set it in the varFrame so that PopCallFrame can use it
+     * command, then set it in the varFrame so that Tcl_PopCallFrame can use it
      * at the proper time.
      */
 
     if (objc > 1) {
-        Tcl_Obj *listPtr, *nsObjPtr;
-        Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
-
-        /* The tailcall data is in a Tcl list: the first element is the
-         * namespace, the rest the command to be tailcalled. */
-
-        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
-        listPtr = Tcl_NewListObj(objc, objv);
- 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
-
-        iPtr->varFramePtr->tailcallPtr = listPtr;
+        iPtr->varFramePtr->tailcallNsPtr = iPtr->varFramePtr->nsPtr;
+	iPtr->varFramePtr->tailcallNsPtr->refCount++;
+        iPtr->varFramePtr->tailcallCmdPtr = Tcl_NewListObj(objc-1, objv+1);
     }
     return TCL_RETURN;
 }
@@ -8722,27 +8736,12 @@ TclNRTailcallEval(
     int result)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *listPtr = data[0], *nsObjPtr;
-    Tcl_Namespace *nsPtr;
+    Tcl_Obj *listPtr = data[0];
+    Tcl_Namespace *nsPtr = data[1];
     int objc;
     Tcl_Obj **objv;
 
     Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
-    nsObjPtr = objv[0];
-
-    if (result == TCL_OK) {
-	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
-    }
-
-    if (result != TCL_OK) {
-        /*
-         * Tailcall execution was preempted, eg by an intervening catch or by
-         * a now-gone namespace: cleanup and return.
-         */
-
-	Tcl_DecrRefCount(listPtr);
-        return result;
-    }
 
     /*
      * Perform the tailcall
@@ -8750,8 +8749,11 @@ TclNRTailcallEval(
 
     TclMarkTailcall(interp);
     TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
+
+    /* Reference count already incremented in TclSetTailcall. */
     iPtr->lookupNsPtr = (Namespace *) nsPtr;
-    return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
+
+    return TclNREvalObjv(interp, objc, objv, 0, NULL);
 }
 
 int
@@ -8849,9 +8851,9 @@ TclNRYieldToObjCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
+    Tcl_Obj *listPtr;
     CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-    Tcl_Obj *listPtr, *nsObjPtr;
-    Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
+    Namespace *nsPtr = (Namespace *)TclGetCurrentNamespace(interp);
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
@@ -8865,30 +8867,19 @@ TclNRYieldToObjCmd(
 	return TCL_ERROR;
     }
 
-    if (((Namespace *) nsPtr)->flags & NS_DYING) {
-        Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"yieldto called in deleted namespace", -1));
-        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
-		NULL);
-        return TCL_ERROR;
-    }
-
     /*
      * Add the tailcall in the caller env, then just yield.
      *
      * This is essentially code from TclNRTailcallObjCmd
      */
-
-    listPtr = Tcl_NewListObj(objc, objv);
-    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
-    TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+    listPtr = Tcl_NewListObj(objc-1, objv+1);
 
     /*
      * Add the callback in the caller's env, then instruct TEBC to yield.
      */
 
     iPtr->execEnvPtr = corPtr->callerEEPtr;
-    TclSetTailcall(interp, listPtr);
+    TclSetTailcall(interp, nsPtr, listPtr);
     iPtr->execEnvPtr = corPtr->eePtr;
 
     return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
@@ -9003,6 +8994,8 @@ NRCoroutineExitCallback(
 
     cmdPtr->deleteProc = NULL;
     Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+
+    /* Corresponding cmdPtr->refCount ++ is in TclNRCoroutineObjCmd */ 
     TclCleanupCommandMacro(cmdPtr);
 
     corPtr->eePtr->corPtr = NULL;
@@ -9377,6 +9370,7 @@ TclNRCoroutineObjCmd(
 
     /* ensure that the command is looked up in the correct namespace */
     iPtr->lookupNsPtr = lookupNsPtr;
+    lookupNsPtr->refCount++;
     Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
     iPtr->numLevels--;
 

generic/tclCompCmdsSZ.c

@@ -2618,14 +2618,11 @@ TclCompileTailcallCmd(
 	return TCL_ERROR;
     }
 
-    /* make room for the nsObjPtr */
-    /* TODO: Doesn't this have to be a known value? */
-    CompileWord(envPtr, tokenPtr, interp, 0);
     for (i=1 ; i<parsePtr->numWords ; i++) {
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, i);
     }
-    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords,	envPtr);
+    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords - 1,	envPtr);
     return TCL_OK;
 }
 
@@ -3937,12 +3934,11 @@ TclCompileYieldToCmd(
 	return TCL_ERROR;
     }
 
-    OP(		NS_CURRENT);
     for (i = 1 ; i < parsePtr->numWords ; i++) {
 	CompileWord(envPtr, tokenPtr, interp, i);
 	tokenPtr = TokenAfter(tokenPtr);
     }
-    OP4(	LIST, i);
+    OP4(	LIST, i-1);
     OP(		YIELD_TO_INVOKE);
     return TCL_OK;
 }

generic/tclCompile.c

@@ -1137,6 +1137,7 @@ CleanupByteCode(
     }
 
     TclHandleRelease(codePtr->interpHandle);
+    TclNsDecrRefCount(codePtr->nsPtr);
     ckfree(codePtr);
 }
 
@@ -2806,6 +2807,7 @@ TclInitByteCode(
     codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
     codePtr->compileEpoch = iPtr->compileEpoch;
     codePtr->nsPtr = namespacePtr;
+    codePtr->nsPtr->refCount++;
     codePtr->nsEpoch = namespacePtr->resolverEpoch;
     codePtr->refCount = 0;
     TclPreserveByteCode(codePtr);

generic/tclEnsemble.c

@@ -150,7 +150,7 @@ TclNamespaceEnsembleCmd(
     const char *simpleName;
     int index, done;
 
-    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
+    if (nsPtr == NULL || nsPtr->flags & NS_DEAD) {
 	if (!Tcl_InterpDeleted(interp)) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "tried to manipulate ensemble of deleted namespace",
@@ -1715,7 +1715,7 @@ NsEnsembleImplementationCmdNR(
 	return TCL_ERROR;
     }
 
-    if (ensemblePtr->nsPtr->flags & NS_DYING) {
+    if (ensemblePtr->nsPtr->flags & NS_DEAD) {
 	/*
 	 * Don't know how we got here, but make things give up quickly.
 	 */
@@ -1911,6 +1911,7 @@ NsEnsembleImplementationCmdNR(
 	TclSkipTailcall(interp);
 	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
 	((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
+	ensemblePtr->nsPtr->refCount++;
 	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
     }
 

generic/tclExecute.c

@@ -2395,7 +2395,8 @@ TEBCresume(
 	Tcl_SetObjResult(interp, OBJ_AT_TOS);
 	goto doYield;
 
-    case INST_YIELD_TO_INVOKE:
+    case INST_YIELD_TO_INVOKE: {
+	Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
 	corPtr = iPtr->execEnvPtr->corPtr;
 	valuePtr = OBJ_AT_TOS;
 	if (!corPtr) {
@@ -2409,17 +2410,6 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	    goto gotError;
 	}
-	if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
-	    TRACE(("[%.30s] => ERROR: yield in deleted\n",
-		    O2S(valuePtr)));
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "yieldto called in deleted namespace", -1));
-	    DECACHE_STACK_INFO();
-	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
-		    NULL);
-	    CACHE_STACK_INFO();
-	    goto gotError;
-	}
 
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceExec >= 2) {
@@ -2443,10 +2433,11 @@ TEBCresume(
 
 	Tcl_IncrRefCount(valuePtr);
 	iPtr->execEnvPtr = corPtr->callerEEPtr;
-	TclSetTailcall(interp, valuePtr);
+	TclSetTailcall(interp, currNsPtr, valuePtr);
 	iPtr->execEnvPtr = corPtr->eePtr;
 	yieldParameter = (PTR2INT(NULL)+1);	/*==CORO_ACTIVATE_YIELDM*/
 
+    }
     doYield:
 	/* TIP #280: Record the last piece of info needed by
 	 * 'TclGetSrcInfoForPc', and push the frame.
@@ -2468,7 +2459,7 @@ TEBCresume(
     }
 
     case INST_TAILCALL: {
-	Tcl_Obj *listPtr, *nsObjPtr;
+	Tcl_Obj *listPtr;
 
 	opnd = TclGetUInt1AtPtr(pc+1);
 
@@ -2504,12 +2495,15 @@ TEBCresume(
 	 */
 
 	listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
-	nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1);
-	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
-	if (iPtr->varFramePtr->tailcallPtr) {
-	    Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
+	if (iPtr->varFramePtr->tailcallNsPtr) {
+	    TclNsDecrRefCount(iPtr->varFramePtr->tailcallNsPtr);
+	    iPtr->varFramePtr->tailcallNsPtr = NULL;
+	    Tcl_DecrRefCount(iPtr->varFramePtr->tailcallCmdPtr);
+	    iPtr->varFramePtr->tailcallCmdPtr = NULL;
 	}
-	iPtr->varFramePtr->tailcallPtr = listPtr;
+	iPtr->varFramePtr->tailcallNsPtr = iPtr->varFramePtr->nsPtr;
+	iPtr->varFramePtr->tailcallNsPtr->refCount++;
+	iPtr->varFramePtr->tailcallCmdPtr = listPtr;
 
 	result = TCL_RETURN;
 	cleanup = opnd;

generic/tclInt.h

@@ -294,10 +294,6 @@ typedef struct Namespace {
 				 * namespace. */
     int flags;			/* OR-ed combination of the namespace status
 				 * flags NS_DYING and NS_DEAD listed below. */
-    int activationCount;	/* Number of "activations" or active call
-				 * frames for this namespace that are on the
-				 * Tcl call stack. The namespace won't be
-				 * freed until activationCount becomes zero. */
     unsigned int refCount;	/* Count of references by namespaceName
 				 * objects. The namespace can't be freed until
 				 * refCount becomes zero. */
@@ -417,11 +413,11 @@ struct NamespacePathEntry {
  *		unit that refers to the namespace has been freed (i.e., when
  *		the namespace's refCount is 0), the namespace's storage will
  *		be freed.
- * NS_KILLED -	1 means that TclTeardownNamespace has already been called on
- *		this namespace and it should not be called again [Bug 1355942]
- * NS_SUPPRESS_COMPILATION -
- *		Marks the commands in this namespace for not being compiled,
- *		forcing them to be looked up every time.
+ * NS_KILLED -	Obsolete. Previously, 1 meant that TclTeardownNamespace has
+ *		already been called on this namespace and it should not be
+ *		called again [Bug 1355942] NS_SUPPRESS_COMPILATION - Marks the
+ *		commands in this namespace for not being compiled, forcing them
+ *		to be looked up every time.
  */
 
 #define NS_DYING	0x01
@@ -1156,7 +1152,8 @@ typedef struct CallFrame {
 				 * meaning of the value is, which we do not
 				 * specify. */
     LocalCache *localCachePtr;
-    Tcl_Obj    *tailcallPtr;
+    Namespace * tailcallNsPtr;
+    Tcl_Obj *tailcallCmdPtr;
 				/* NULL if no tailcall is scheduled */
 } CallFrame;
 
@@ -2829,7 +2826,8 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
 MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;
 
-MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
+MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Namespace *nsPtr,
+			    Tcl_Obj *listPtr);
 MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);
 
 /* These two can be considered for the public api */
@@ -4833,7 +4831,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
  */
 
 #define TclGetCurrentNamespace(interp) \
-    (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr
+    (Tcl_Namespace *) ((((Interp *)(interp))->varFramePtr->nsPtr->flags & NS_DEAD) \
+	? ((Interp *) (interp))->globalNsPtr \
+	: ((Interp *) (interp))->varFramePtr->nsPtr)
 
 #define TclGetGlobalNamespace(interp) \
     (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr

generic/tclNamesp.c

@@ -308,8 +308,8 @@ Tcl_PushCallFrame(
 	nsPtr = (Namespace *) namespacePtr;
 
 	/*
-	 * TODO: Examine whether it would be better to guard based on NS_DYING
-	 * or NS_KILLED. It appears that these are not tested because they can
+	 * TODO: Examine whether it would be better to guard based on NS_DYING.
+	 * It appears that these are not tested because they can
 	 * be set in a global interp that has been [namespace delete]d, but
 	 * which never really completely goes away because of lingering global
 	 * things like ::errorInfo and [::unknown] and hidden commands.
@@ -322,7 +322,7 @@ Tcl_PushCallFrame(
 	}
     }
 
-    nsPtr->activationCount++;
+    nsPtr->refCount++;
     framePtr->nsPtr = nsPtr;
     framePtr->isProcCallFrame = isProcCallFrame;
     framePtr->objc = 0;
@@ -340,7 +340,8 @@ Tcl_PushCallFrame(
     framePtr->compiledLocals = NULL;
     framePtr->clientData = NULL;
     framePtr->localCachePtr = NULL;
-    framePtr->tailcallPtr = NULL;
+    framePtr->tailcallNsPtr = NULL;
+    framePtr->tailcallCmdPtr = NULL;
 
     /*
      * Push the new call frame onto the interpreter's stack of procedure call
@@ -378,7 +379,6 @@ Tcl_PopCallFrame(
 {
     register Interp *iPtr = (Interp *) interp;
     register CallFrame *framePtr = iPtr->framePtr;
-    Namespace *nsPtr;
 
     /*
      * It's important to remove the call frame from the interpreter's stack of
@@ -407,21 +407,18 @@ Tcl_PopCallFrame(
     }
 
     /*
-     * Decrement the namespace's count of active call frames. If the namespace
-     * is "dying" and there are no more active call frames, call
-     * Tcl_DeleteNamespace to destroy it.
+     * Decrement the namespace's count of active call frames.
      */
 
-    nsPtr = framePtr->nsPtr;
-    nsPtr->activationCount--;
-    if ((nsPtr->flags & NS_DYING)
-	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
-	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
-    }
+    /* Corresponds to refCount++ in Tcl_PushCallFrame */
+    TclNsDecrRefCount(framePtr->nsPtr);
     framePtr->nsPtr = NULL;
 
-    if (framePtr->tailcallPtr) {
-	TclSetTailcall(interp, framePtr->tailcallPtr);
+    if (framePtr->tailcallNsPtr) {
+	TclSetTailcall(interp, framePtr->tailcallNsPtr,
+	    framePtr->tailcallCmdPtr);
+	TclNsDecrRefCount(framePtr->tailcallNsPtr);
+	framePtr->tailcallNsPtr = NULL;
     }
 }
 
@@ -784,8 +781,8 @@ Tcl_CreateNamespace(
     nsPtr->nsId = ++(tsdPtr->numNsCreated);
     nsPtr->interp = interp;
     nsPtr->flags = 0;
-    nsPtr->activationCount = 0;
-    nsPtr->refCount = 0;
+    /* Corresponding TclNsDecrRefCount is at the end of Tcl_DeleteNamespace */
+    nsPtr->refCount = 1;
     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
     TclInitVarHashTable(&nsPtr->varTable, nsPtr);
     nsPtr->exportArrayPtr = NULL;
@@ -905,18 +902,20 @@ void
 Tcl_DeleteNamespace(
     Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
 {
-    register Namespace *nsPtr = (Namespace *) namespacePtr;
+    int i, newChildren;
+    register Namespace *nsPtr = (Namespace *) namespacePtr, *childPtr ;
     Interp *iPtr = (Interp *) nsPtr->interp;
     Namespace *globalNsPtr = (Namespace *)
-	    TclGetGlobalNamespace((Tcl_Interp *) iPtr);
-    Tcl_HashEntry *entryPtr;
+	TclGetGlobalNamespace((Tcl_Interp *) iPtr);
+    register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
     Command *cmdPtr;
 
-    /*
-     * Ensure that this namespace doesn't get deallocated in the meantime.
-     */
-    nsPtr->refCount++;
+    if (nsPtr->flags & NS_DYING) {
+	return;
+    }
+
+    nsPtr->flags |= NS_DYING;
 
     /*
      * Give anyone interested - notably TclOO - a chance to use this namespace
@@ -933,50 +932,168 @@ Tcl_DeleteNamespace(
 	Tcl_NamespaceDeleteProc *earlyDeleteProc = nsPtr->earlyDeleteProc;
 
 	nsPtr->earlyDeleteProc = NULL;
-	nsPtr->activationCount++;
 	earlyDeleteProc(nsPtr->clientData);
-	nsPtr->activationCount--;
     }
 
-    /*
-     * Delete all coroutine commands now: break the circular ref cycle between
-     * the namespace and the coroutine command [Bug 2724403]. This code is
-     * essentially duplicated in TclTeardownNamespace() for all other
-     * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
-     *
-     * NOTE: we could avoid traversing the ns's command list by keeping a
-     * separate list of coros.
-     */
-
-    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-	    entryPtr != NULL;) {
-	cmdPtr = Tcl_GetHashValue(entryPtr);
-	if (cmdPtr->nreProc == TclNRInterpCoroutine) {
-	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
-		    (Tcl_Command) cmdPtr);
-	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-	} else {
-	    entryPtr = Tcl_NextHashEntry(&search);
-	}
-    }
-
-    /*
-     * If the namespace has associated ensemble commands, delete them first.
-     * This leaves the actual contents of the namespace alone (unless they are
-     * linked ensemble commands, of course). Note that this code is actually
-     * reentrant so command delete traces won't purturb things badly.
-     */
-
-    while (nsPtr->ensembles != NULL) {
-	EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles;
+    do {
 
 	/*
-	 * Splice out and link to indicate that we've already been killed.
+	 * If the namespace has associated ensemble commands, delete them first.
+	 * This leaves the actual contents of the namespace alone (unless they are
+	 * linked ensemble commands, of course). Note that this code is actually
+	 * reentrant so command delete traces won't purturb things badly.
 	 */
 
-	nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
-	ensemblePtr->next = ensemblePtr;
-	Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token);
+	while (nsPtr->ensembles != NULL) {
+	    EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles;
+
+	    /*
+	     * Splice out and link to indicate that we've already been killed.
+	     */
+
+	    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
+	    ensemblePtr->next = ensemblePtr;
+	    Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token);
+	}
+
+
+	/*
+	 * Delete all coroutine commands now: break the circular ref cycle between
+	 * the namespace and the coroutine command [Bug 2724403]. This code is
+	 * essentially duplicated in TclTeardownNamespace() for all other
+	 * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
+	 *
+	 * NOTE: we could avoid traversing the ns's command list by keeping a
+	 * separate list of coros.
+	 */
+
+	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+		entryPtr != NULL;) {
+	    cmdPtr = Tcl_GetHashValue(entryPtr);
+	    if (cmdPtr->nreProc == TclNRInterpCoroutine) {
+		Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
+			(Tcl_Command) cmdPtr);
+		entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+	    } else {
+		entryPtr = Tcl_NextHashEntry(&search);
+	    }
+	}
+
+	/*
+	 * Delete all the child namespaces.
+	 *
+	 * BE CAREFUL: When each child is deleted, it will divorce itself from its
+	 * parent. You can't traverse a hash table properly if its elements are
+	 * being deleted.  Because of traces (and the desire to avoid the
+	 * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
+	 * f97d4ee020]) we copy to a temporary array and then delete all those
+	 * namespaces.
+	 *
+	 * Important: leave the hash table itself still live.
+	 */
+
+#ifndef BREAK_NAMESPACE_COMPAT
+	do {
+	    int length = nsPtr->childTable.numEntries;
+	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+		    sizeof(Namespace *) * length);
+	    newChildren = 0;
+
+	    i = 0;
+	    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+		    entryPtr != NULL;
+		    entryPtr = Tcl_NextHashEntry(&search)) {
+		children[i] = Tcl_GetHashValue(entryPtr);
+		children[i]->refCount++;
+		i++;
+	    }
+	    for (i = 0 ; i < length ; i++) {
+		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+		TclNsDecrRefCount(children[i]);
+	    }
+	    TclStackFree((Tcl_Interp *) iPtr, children);
+	    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+		    entryPtr != NULL;
+		    entryPtr = Tcl_NextHashEntry(&search)) {
+		childPtr = Tcl_GetHashValue(entryPtr);
+		if (!(childPtr->flags & NS_DYING)) {
+		    newChildren = 1;
+		    break;
+		}
+	    }
+
+	} while (newChildren);
+#else
+	if (nsPtr->childTablePtr != NULL) {
+	    while (nsPtr->childTablePtr->numEntries > 0) {
+		int length = nsPtr->childTablePtr->numEntries;
+		Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+			sizeof(Namespace *) * length);
+
+		i = 0;
+		for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+			entryPtr != NULL;
+			entryPtr = Tcl_NextHashEntry(&search)) {
+		    children[i] = Tcl_GetHashValue(entryPtr);
+		    children[i]->refCount++;
+		    i++;
+		}
+		for (i = 0 ; i < length ; i++) {
+		    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+		    TclNsDecrRefCount(children[i]);
+		}
+		TclStackFree((Tcl_Interp *) iPtr, children);
+	    }
+	}
+#endif
+	/*
+	 * Delete all commands in this namespace. Be careful when traversing the
+	 * hash table: when each command is deleted, it removes itself from the
+	 * command table. Because of traces (and the desire to avoid the quadratic
+	 * problems of just using Tcl_FirstHashEntry over and over, [Bug
+	 * f97d4ee020]) we copy to a temporary array and then delete all those
+	 * commands.
+	 */
+
+	while (nsPtr->cmdTable.numEntries > 0) {
+	    int length = nsPtr->cmdTable.numEntries;
+	    Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
+		    sizeof(Command *) * length);
+
+	    i = 0;
+	    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+		    entryPtr != NULL;
+		    entryPtr = Tcl_NextHashEntry(&search)) {
+		cmds[i] = Tcl_GetHashValue(entryPtr);
+		cmds[i]->refCount++;
+		i++;
+	    }
+	    for (i = 0 ; i < length ; i++) {
+		Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
+			(Tcl_Command) cmds[i]);
+		TclCleanupCommandMacro(cmds[i]);
+	    }
+	    TclStackFree((Tcl_Interp *) iPtr, cmds);
+	}
+
+	/*
+	 * Destroying the namespace's variable table, which may trigger traces.
+	 * Variable table should be cleared but not freed!
+	 * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
+	 */
+
+	TclDeleteNamespaceVars(nsPtr);
+	TclInitVarHashTable(&nsPtr->varTable, nsPtr);
+
+    } while (nsPtr->varTable.table.numEntries > 0
+	|| newChildren || nsPtr->ensembles != NULL);
+
+    /*
+     * Free any client data associated with the namespace.
+     */
+
+    if (nsPtr->deleteProc != NULL) {
+	nsPtr->deleteProc(nsPtr->clientData);
     }
 
     /*
@@ -990,84 +1107,83 @@ Tcl_DeleteNamespace(
     }
 
     /*
-     * If the namespace is on the call frame stack, it is marked as "dying"
-     * (NS_DYING is OR'd into its flags): the namespace can't be looked up by
-     * name but its commands and variables are still usable by those active
-     * call frames. When all active call frames referring to the namespace
-     * have been popped from the Tcl stack, Tcl_PopCallFrame will call this
-     * function again to delete everything in the namespace. If no nsName
-     * objects refer to the namespace (i.e., if its refCount is zero), its
-     * commands and variables are deleted and the storage for its namespace
-     * structure is freed. Otherwise, if its refCount is nonzero, the
-     * namespace's commands and variables are deleted but the structure isn't
-     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
-     * namespace resolution code to recognize that the namespace is "deleted".
-     * The structure's storage is freed by FreeNsNameInternalRep when its
-     * refCount reaches 0.
+     * Remove the namespace from its parent's child hashtable.
      */
 
-    if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
-	nsPtr->flags |= NS_DYING;
-	if (nsPtr->parentPtr != NULL) {
-	    entryPtr = Tcl_FindHashEntry(
-		    TclGetNamespaceChildTable((Tcl_Namespace *)
-			    nsPtr->parentPtr), nsPtr->name);
-	    if (entryPtr != NULL) {
-		Tcl_DeleteHashEntry(entryPtr);
-	    }
-	}
-	nsPtr->parentPtr = NULL;
-    } else if (!(nsPtr->flags & NS_KILLED)) {
-	/*
-	 * Delete the namespace and everything in it. If this is the global
-	 * namespace, then clear it but don't free its storage unless the
-	 * interpreter is being torn down. Set the NS_KILLED flag to avoid
-	 * recursive calls here - if the namespace is really in the process of
-	 * being deleted, ignore any second call.
-	 */
-
-	nsPtr->flags |= (NS_DYING|NS_KILLED);
-
-	TclTeardownNamespace(nsPtr);
-
-	if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
-	    /*
-	     * If this is the global namespace, then it may have residual
-	     * "errorInfo" and "errorCode" variables for errors that occurred
-	     * while it was being torn down. Try to clear the variable list
-	     * one last time.
-	     */
-
-	    TclDeleteNamespaceVars(nsPtr);
-
-#ifndef BREAK_NAMESPACE_COMPAT
-	    Tcl_DeleteHashTable(&nsPtr->childTable);
-#else
-	    if (nsPtr->childTablePtr != NULL) {
-		Tcl_DeleteHashTable(nsPtr->childTablePtr);
-		ckfree(nsPtr->childTablePtr);
-	    }
-#endif
-	    Tcl_DeleteHashTable(&nsPtr->cmdTable);
-
-	    nsPtr ->flags |= NS_DEAD;
-	} else {
-	    /*
-	     * Restore the ::errorInfo and ::errorCode traces.
-	     */
-
-	    EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
-	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
-
-	    /*
-	     * We didn't really kill it, so remove the KILLED marks, so it can
-	     * get killed later, avoiding mem leaks.
-	     */
-
-	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
+    if (nsPtr->parentPtr != NULL) {
+	entryPtr = Tcl_FindHashEntry(
+		TclGetNamespaceChildTable((Tcl_Namespace *)
+			nsPtr->parentPtr), nsPtr->name);
+	if (entryPtr != NULL) {
+	    Tcl_DeleteHashEntry(entryPtr);
 	}
     }
-    TclNsDecrRefCount(nsPtr);
+
+    nsPtr->parentPtr = NULL;
+
+
+    /*
+     * Delete the namespace path if one is installed.
+     */
+
+    if (nsPtr->commandPathLength != 0) {
+	UnlinkNsPath(nsPtr);
+	nsPtr->commandPathLength = 0;
+    }
+    if (nsPtr->commandPathSourceList != NULL) {
+	NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;
+
+	do {
+	    if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) {
+		nsPathPtr->creatorNsPtr->cmdRefEpoch++;
+	    }
+	    nsPathPtr->nsPtr = NULL;
+	    nsPathPtr = nsPathPtr->nextPtr;
+	} while (nsPathPtr != NULL);
+	nsPtr->commandPathSourceList = NULL;
+    }
+
+
+    /*
+     * Reset the namespace's id field to ensure that this namespace won't be
+     * interpreted as valid by, e.g., the cache validation code for cached
+     * command references in Tcl_GetCommandFromObj.
+     */
+
+    nsPtr->nsId = 0;
+
+    if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
+
+	/* No variables or commands are allowed after this point */
+	nsPtr->flags |= NS_DEAD;
+	Tcl_DeleteHashTable(&nsPtr->varTable.table);
+	Tcl_DeleteHashTable(&nsPtr->cmdTable);
+
+
+#ifndef BREAK_NAMESPACE_COMPAT
+	Tcl_DeleteHashTable(&nsPtr->childTable);
+#else
+	if (nsPtr->childTablePtr != NULL) {
+	    Tcl_DeleteHashTable(nsPtr->childTablePtr);
+	    ckfree(nsPtr->childTablePtr);
+	}
+#endif
+	TclNsDecrRefCount(nsPtr);
+    } else {
+	/*
+	 * Restore the ::errorInfo and ::errorCode traces.
+	 */
+
+	EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+	EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+
+	/*
+	 * We didn't really kill it, so remove the KILLED marks, so it can
+	 * get killed later, avoiding mem leaks.
+	 */
+
+	nsPtr->flags &= ~(NS_DYING|NS_DEAD);
+    }
 }
 
 /*
@@ -1097,144 +1213,8 @@ TclTeardownNamespace(
     register Namespace *nsPtr)	/* Points to the namespace to be dismantled
 				 * and unlinked from its parent. */
 {
-    Interp *iPtr = (Interp *) nsPtr->interp;
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
     int i;
 
-    /*
-     * Start by destroying the namespace's variable table, since variables
-     * might trigger traces. Variable table should be cleared but not freed!
-     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
-     */
-
-    TclDeleteNamespaceVars(nsPtr);
-    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
-
-    /*
-     * Delete all commands in this namespace. Be careful when traversing the
-     * hash table: when each command is deleted, it removes itself from the
-     * command table. Because of traces (and the desire to avoid the quadratic
-     * problems of just using Tcl_FirstHashEntry over and over, [Bug
-     * f97d4ee020]) we copy to a temporary array and then delete all those
-     * commands.
-     */
-
-    while (nsPtr->cmdTable.numEntries > 0) {
-	int length = nsPtr->cmdTable.numEntries;
-	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
-		sizeof(Command *) * length);
-
-	i = 0;
-	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-		entryPtr != NULL;
-		entryPtr = Tcl_NextHashEntry(&search)) {
-	    cmds[i] = Tcl_GetHashValue(entryPtr);
-	    cmds[i]->refCount++;
-	    i++;
-	}
-	for (i = 0 ; i < length ; i++) {
-	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
-		    (Tcl_Command) cmds[i]);
-	    TclCleanupCommandMacro(cmds[i]);
-	}
-	TclStackFree((Tcl_Interp *) iPtr, cmds);
-    }
-    Tcl_DeleteHashTable(&nsPtr->cmdTable);
-    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
-
-    /*
-     * Remove the namespace from its parent's child hashtable.
-     */
-
-    if (nsPtr->parentPtr != NULL) {
-	entryPtr = Tcl_FindHashEntry(
-		TclGetNamespaceChildTable((Tcl_Namespace *)
-			nsPtr->parentPtr), nsPtr->name);
-	if (entryPtr != NULL) {
-	    Tcl_DeleteHashEntry(entryPtr);
-	}
-    }
-    nsPtr->parentPtr = NULL;
-
-    /*
-     * Delete the namespace path if one is installed.
-     */
-
-    if (nsPtr->commandPathLength != 0) {
-	UnlinkNsPath(nsPtr);
-	nsPtr->commandPathLength = 0;
-    }
-    if (nsPtr->commandPathSourceList != NULL) {
-	NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;
-
-	do {
-	    if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) {
-		nsPathPtr->creatorNsPtr->cmdRefEpoch++;
-	    }
-	    nsPathPtr->nsPtr = NULL;
-	    nsPathPtr = nsPathPtr->nextPtr;
-	} while (nsPathPtr != NULL);
-	nsPtr->commandPathSourceList = NULL;
-    }
-
-    /*
-     * Delete all the child namespaces.
-     *
-     * BE CAREFUL: When each child is deleted, it will divorce itself from its
-     * parent. You can't traverse a hash table properly if its elements are
-     * being deleted.  Because of traces (and the desire to avoid the
-     * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
-     * f97d4ee020]) we copy to a temporary array and then delete all those
-     * namespaces.
-     *
-     * Important: leave the hash table itself still live.
-     */
-
-#ifndef BREAK_NAMESPACE_COMPAT
-    while (nsPtr->childTable.numEntries > 0) {
-	int length = nsPtr->childTable.numEntries;
-	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
-		sizeof(Namespace *) * length);
-
-	i = 0;
-	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-		entryPtr != NULL;
-		entryPtr = Tcl_NextHashEntry(&search)) {
-	    children[i] = Tcl_GetHashValue(entryPtr);
-	    children[i]->refCount++;
-	    i++;
-	}
-	for (i = 0 ; i < length ; i++) {
-	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
-	    TclNsDecrRefCount(children[i]);
-	}
-	TclStackFree((Tcl_Interp *) iPtr, children);
-    }
-#else
-    if (nsPtr->childTablePtr != NULL) {
-	while (nsPtr->childTablePtr->numEntries > 0) {
-	    int length = nsPtr->childTablePtr->numEntries;
-	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
-		    sizeof(Namespace *) * length);
-
-	    i = 0;
-	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
-		    entryPtr != NULL;
-		    entryPtr = Tcl_NextHashEntry(&search)) {
-		children[i] = Tcl_GetHashValue(entryPtr);
-		children[i]->refCount++;
-		i++;
-	    }
-	    for (i = 0 ; i < length ; i++) {
-		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
-		TclNsDecrRefCount(children[i]);
-	    }
-	    TclStackFree((Tcl_Interp *) iPtr, children);
-	}
-    }
-#endif
-
     /*
      * Free the namespace's export pattern array.
      */
@@ -1249,23 +1229,7 @@ TclTeardownNamespace(
 	nsPtr->maxExportPatterns = 0;
     }
 
-    /*
-     * Free any client data associated with the namespace.
-     */
-
-    if (nsPtr->deleteProc != NULL) {
-	nsPtr->deleteProc(nsPtr->clientData);
-    }
-    nsPtr->deleteProc = NULL;
-    nsPtr->clientData = NULL;
-
-    /*
-     * Reset the namespace's id field to ensure that this namespace won't be
-     * interpreted as valid by, e.g., the cache validation code for cached
-     * command references in Tcl_GetCommandFromObj.
-     */
-
-    nsPtr->nsId = 0;
+    NamespaceFree(nsPtr);
 }
 
 /*
@@ -1321,8 +1285,8 @@ void
 TclNsDecrRefCount(
     Namespace *nsPtr)
 {
-    if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
-	NamespaceFree(nsPtr);
+    if (nsPtr->refCount-- == 1) {
+	TclTeardownNamespace(nsPtr);
     }
 }
 
@@ -2221,7 +2185,7 @@ TclGetNamespaceForQualName(
     if (flags & TCL_GLOBAL_ONLY) {
 	nsPtr = globalNsPtr;
     } else if (nsPtr == NULL) {
-	nsPtr = iPtr->varFramePtr->nsPtr;
+	nsPtr = (Namespace *)TclGetCurrentNamespace(iPtr);
     }
 
     start = qualName;			/* Points to start of qualifying
@@ -2439,7 +2403,7 @@ TclEnsureNamespace(
     Tcl_Namespace *namespacePtr)
 {
     Namespace *nsPtr = (Namespace *) namespacePtr;
-    if (!(nsPtr->flags & NS_DYING)) {
+    if (!(nsPtr->flags & NS_DEAD)) {
 	    return namespacePtr;
     }
     return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
@@ -2612,7 +2576,7 @@ Tcl_FindCommand(
 		&simpleName);
 	if ((realNsPtr != NULL) && (simpleName != NULL)) {
 	    if ((cxtNsPtr == realNsPtr)
-		    || !(realNsPtr->flags & NS_DYING)) {
+		    || !(realNsPtr->flags & NS_DEAD)) {
 		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
 		if (entryPtr != NULL) {
 		    cmdPtr = Tcl_GetHashValue(entryPtr);
@@ -2633,7 +2597,7 @@ Tcl_FindCommand(
 		    TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
 		    &simpleName);
 	    if ((realNsPtr != NULL) && (simpleName != NULL)
-		    && !(realNsPtr->flags & NS_DYING)) {
+		    && !(realNsPtr->flags & NS_DEAD)) {
 		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
 		if (entryPtr != NULL) {
 		    cmdPtr = Tcl_GetHashValue(entryPtr);
@@ -2651,7 +2615,7 @@ Tcl_FindCommand(
 		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
 		    &simpleName);
 	    if ((realNsPtr != NULL) && (simpleName != NULL)
-		    && !(realNsPtr->flags & NS_DYING)) {
+		    && !(realNsPtr->flags & NS_DEAD)) {
 		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
 		if (entryPtr != NULL) {
 		    cmdPtr = Tcl_GetHashValue(entryPtr);
@@ -2671,15 +2635,18 @@ Tcl_FindCommand(
 	 * context and from the global namespace.
 	 */
 
-	for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
-	    if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
-		entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
-			simpleName);
-		if (entryPtr != NULL) {
-		    cmdPtr = Tcl_GetHashValue(entryPtr);
+	    for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
+		if ((nsPtr[search] != NULL) && (simpleName != NULL)
+		    && !(nsPtr[search]->flags & NS_DEAD)) {
+
+		    entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
+			    simpleName);
+		    if (entryPtr != NULL) {
+			cmdPtr = Tcl_GetHashValue(entryPtr);
+		    }
 		}
 	    }
-	}
+
     }
 
     if (cmdPtr != NULL) {
@@ -2909,7 +2876,7 @@ GetNamespaceFromObj(
 	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	nsPtr = resNamePtr->nsPtr;
 	refNsPtr = resNamePtr->refNsPtr;
-	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
+	if (!(nsPtr->flags & NS_DEAD) && (interp == nsPtr->interp)
 		&& (!refNsPtr || (refNsPtr ==
 		(Namespace *) TclGetCurrentNamespace(interp)))) {
 	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
@@ -3268,7 +3235,7 @@ NamespaceDeleteCmd(
 	name = TclGetString(objv[i]);
 	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
 	if ((namespacePtr == NULL)
-		|| (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
+		|| (((Namespace *) namespacePtr)->flags & NS_DEAD)) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                     "unknown namespace \"%s\" in namespace delete command",
 		    TclGetString(objv[i])));
@@ -4702,6 +4669,9 @@ FreeNsNameInternalRep(
 	 */
 
 	TclNsDecrRefCount(resNamePtr->nsPtr);
+	if (resNamePtr->refNsPtr) {
+	    TclNsDecrRefCount(resNamePtr->refNsPtr);
+	}
 	ckfree(resNamePtr);
     }
     objPtr->typePtr = NULL;
@@ -4785,7 +4755,7 @@ SetNsNameFromAny(
      * that holds a reference to it.
      */
 
-    if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
+    if ((nsPtr == NULL) || (nsPtr->flags & NS_DEAD)) {
 	/*
 	 * Our failed lookup proves any previously cached nsName intrep is no
 	 * longer valid. Get rid of it so we no longer waste memory storing
@@ -4798,13 +4768,14 @@ SetNsNameFromAny(
 	return TCL_ERROR;
     }
 
-    nsPtr->refCount++;
     resNamePtr = ckalloc(sizeof(ResolvedNsName));
     resNamePtr->nsPtr = nsPtr;
+    nsPtr->refCount++;
     if ((name[0] == ':') && (name[1] == ':')) {
 	resNamePtr->refNsPtr = NULL;
     } else {
 	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+	resNamePtr->refNsPtr->refCount++;
     }
     resNamePtr->refCount = 1;
     TclFreeIntRep(objPtr);

generic/tclOO.c

@@ -1146,7 +1146,8 @@ ObjectNamespaceDeleted(
      * points into freed memory.
      */
 
-    if (((Command *)oPtr->command)->flags && CMD_IS_DELETED) {
+    if (oPtr->command == NULL || ((
+	Command *)oPtr->command)->flags & CMD_IS_DELETED) {
 	/*
 	 * Something has already started the command deletion process. We can
 	 * go ahead and clean up the the namespace,

generic/tclOOMethod.c

@@ -868,6 +868,8 @@ PushMethodCallFrame(
 	ByteCode *codePtr =
 		pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
 
+	nsPtr->refCount++;
+	TclNsDecrRefCount(codePtr->nsPtr);
 	codePtr->nsPtr = nsPtr;
     }
     result = TclProcCompileProc(interp, pmPtr->procPtr,
@@ -1490,6 +1492,8 @@ InvokeForwardMethod(
      */
     ((Interp *)interp)->lookupNsPtr
 	    = (Namespace *) contextPtr->oPtr->namespacePtr;
+    /* Corresponding TclNrDecrRefCount is in EvalObjvCore */ 
+    ((Namespace *)contextPtr->oPtr->namespacePtr)->refCount++;
     return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
 }
 

generic/tclObj.c

@@ -4133,7 +4133,7 @@ Tcl_GetCommandFromObj(
 
         if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
                 && (interp == cmdPtr->nsPtr->interp)
-                && !(cmdPtr->nsPtr->flags & NS_DYING)) {
+                && !(cmdPtr->nsPtr->flags & NS_DEAD)) {
             register Namespace *refNsPtr = (Namespace *)
                     TclGetCurrentNamespace(interp);
 

generic/tclProc.c

@@ -1893,6 +1893,8 @@ TclProcCompileProc(
 		return TCL_ERROR;
 	    }
 	    codePtr->compileEpoch = iPtr->compileEpoch;
+	    nsPtr->refCount++;
+	    TclNsDecrRefCount(codePtr->nsPtr);
 	    codePtr->nsPtr = nsPtr;
 	} else {
 	    TclFreeIntRep(bodyPtr);

generic/tclVar.c

@@ -819,6 +819,9 @@ TclLookupSimpleVar(
 	cxtNsPtr = iPtr->globalNsPtr;
     } else {
 	cxtNsPtr = iPtr->varFramePtr->nsPtr;
+	if (cxtNsPtr->flags & NS_DEAD) {
+	    cxtNsPtr = iPtr->globalNsPtr;
+	}
     }
 
     /*
@@ -828,7 +831,7 @@ TclLookupSimpleVar(
      */
 
     if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
-	    && !(flags & TCL_AVOID_RESOLVERS)) {
+	    && !(flags & TCL_AVOID_RESOLVERS) && !(cxtNsPtr->flags & NS_DEAD)) {
 	resPtr = iPtr->resolverPtr;
 	if (cxtNsPtr->varResProc) {
 	    result = cxtNsPtr->varResProc(interp, varName,

tests/basic.test

@@ -991,9 +991,9 @@ test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup {
 } -result {0 {}}
 
 # Clean up after expand tests
-unset noComp l1 l2 constraints
-rename l3 {}
-rename run {}
+catch {unset noComp l1 l2 constraints}
+catch {rename l3 {}}
+catch {rename run {}}
 
  #cleanup
 catch {namespace delete {*}[namespace children :: test_ns_*]}

tests/coroutine.test

@@ -658,10 +658,10 @@ test coroutine-7.8 {yieldto context nuke: Bug a90d9331bc} -setup {
     lappend ::result [cotest]
     cotest
     return $result
-} -returnCodes error -cleanup {
+} -cleanup {
     catch {namespace delete ::cotest}
     catch {rename cotest ""}
-} -result {yieldto called in deleted namespace}
+} -result {a OUT b 123 c}
 test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
     namespace eval cotest {}
     set ::result ""
@@ -681,10 +681,10 @@ test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
     lappend ::result [cotest]
     cotest
     return $result
-} -returnCodes error -cleanup {
+} -cleanup {
     catch {namespace delete ::cotest}
     catch {rename cotest ""}
-} -result {yieldto called in deleted namespace}
+} -result {a OUT b 123 c}
 test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
     namespace eval cotest {}
     set ::result ""
@@ -701,10 +701,10 @@ test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
     lappend ::result [cotest]
     cotest
     return $result
-} -returnCodes error -cleanup {
+} -cleanup {
     catch {namespace delete ::cotest}
     catch {rename cotest ""}
-} -result {yieldto called in deleted namespace}
+} -result {a OUT b 123 c}
 test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
     namespace eval cotest {}
     set ::result ""
@@ -722,10 +722,10 @@ test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
     lappend ::result [cotest]
     cotest
     return $result
-} -returnCodes error -cleanup {
+} -cleanup {
     catch {namespace delete ::cotest}
     catch {rename cotest ""}
-} -result {yieldto called in deleted namespace}
+} -result {a OUT b 123 c}
 test coroutine-7.12 {coro floor above street level #3008307} -body {
     proc c {} {
 	yield

tests/interp.test

@@ -20,6 +20,24 @@ catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testinterpdelete [llength [info commands testinterpdelete]]
 
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
+
+
 set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}
 
 foreach i [interp slaves] {
@@ -883,6 +901,15 @@ test interp-18.10 {eval in deleted interp, bug 495830} {
     list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
 } {1 {attempt to call eval in deleted interpreter}}
 
+test interp-10.11 {test for leaks in simple creation/deletion} -setup {
+} -constraints memory -body {
+    leaktest {
+	interp create slave
+	interp delete slave
+    }
+} -cleanup {
+} -result 0
+
 # Test alias deletion
 
 test interp-19.1 {alias deletion} {

tests/namespace.test

@@ -137,7 +137,7 @@ test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
         }
     }
     list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
-} {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
+} {:: 1 {invalid command name "test_ns_1::p"}}
 test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
     namespace eval test_ns_2 {
         proc p {} {
@@ -209,6 +209,53 @@ test namespace-7.8 {Bug ba1419303b4c} -setup {
     namespace delete ns1
 } -result {}
 
+test namespace-7.9 {
+    Looking up a command when the current namespace is deleted
+} -body {
+    list [catch {
+	namespace eval ns1 {
+	    proc p1 {} {}
+	    namespace delete [namespace current]
+	    p1
+	}
+    } msg] $msg
+} -result {1 {invalid command name "p1"}} 
+
+test namespace-7.10 {
+    A namespace can be looked up during the delete process.
+} -body {
+    variable res failure 
+    namespace eval ns1 {
+	namespace ensemble create
+	trace add command [namespace current] delete [list ::apply [list args {
+	    set [namespace parent]::res triggered
+	} [namespace current]]]
+	namespace delete [namespace current]
+    }
+    return $res
+} -cleanup {
+    unset res
+} -result triggered 
+
+test namespace-7.11 {
+    Commands are deleted before variables.
+} -body {
+    variable res failure 
+    namespace eval ns1 {
+	namespace ensemble create
+	namespace upvar [namespace parent] res res
+	proc p1 {} {}
+	trace add command p1 delete [list ::apply [list args {
+	    variable res
+	    set res triggered
+	} [namespace current]]]
+	namespace delete [namespace current]
+    }
+    return $res
+} -cleanup {
+    unset res
+} -result triggered
+
 test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
     catch {interp delete test_interp}
     interp create test_interp
@@ -1589,7 +1636,7 @@ test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
         }
     }
     test_ns_1::p
-} -result {::test_ns_1}
+} -result {::}
 test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
     namespace eval test_ns_1 {
         proc q {} {
@@ -2088,7 +2135,7 @@ test namespace-46.8 {ensemble: implementation deletes its namespace} {
 	namespace ensemble create
     }
     list [ns foo] [info exist ns::x]
-} {1 0}
+} {0 0}
 test namespace-46.9 {ensemble: configuring really configures things} {
     namespace eval ns {
 	namespace ensemble create -map {a a} -prefixes 0
@@ -2743,8 +2790,7 @@ test namespace-51.13 {name resolution path control} -body {
 	}
 	bar
     }
-    # Should the result be "2 {} {2 3 2 1}" instead?
-} -result {2 {} {2 3 1 1}} -cleanup {
+} -result {2 {} {2 3 2 2 1}} -cleanup {
     catch {namespace delete ::test_ns_1}
     catch {namespace delete ::test_ns_2}
     catch {namespace delete ::test_ns_3}
@@ -3282,15 +3328,23 @@ test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} {
     }
     namespace delete ::testing
 } {}
-test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} {
-    namespace eval ::testing {
-	namespace eval abc {proc xyz {} {}}
-	namespace eval def {proc xyz {} {}}
-	trace add command abc::xyz delete "namespace delete ::testing::def {}; #"
-	trace add command def::xyz delete "namespace delete ::testing::abc {}; #"
+test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} -setup {
+    # Since this test deletes the global namespace, isolate the carnage in a
+    # slave.
+    interp create slave
+} -body {
+    slave eval {
+	namespace eval ::testing {
+	    namespace eval abc {proc xyz {} {}}
+	    namespace eval def {proc xyz {} {}}
+	    trace add command abc::xyz delete "namespace delete ::testing::def {}; #"
+	    trace add command def::xyz delete "namespace delete ::testing::abc {}; #"
+	}
+	namespace delete ::testing
     }
-    namespace delete ::testing
-} {}
+} -cleanup {
+    interp delete slave
+} -result {}
 test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
     namespace eval ::testing {
 	variable gone {}

tests/oo.test

@@ -612,10 +612,10 @@ test oo-3.5a {basic test of OO functionality: destructor: evil case for Itcl} -s
 	}
 	method nuke {} {
 	    namespace delete [namespace current]
-	    return $result
+	    return $::result
 	}
 	destructor {
-	    lappend result [self] $state [info commands localcmdexists]
+	    lappend ::result [self] $state [info commands localcmdexists]
 	}
     }
     cls create obj

tests/trace.test

@@ -2478,7 +2478,7 @@ test trace-34.5 {Bug 1047286} {
     trace add command ::foo::bar delete [namespace code callback]
     namespace eval ::foo namespace delete ::foo
     set x
-} {::foo::bar exists: }
+} {::foo::bar exists: ::foo::bar}
 
 test trace-34.6 {Bug 1458266} -setup {
     proc dummy {} {}

tests/var.test

@@ -154,50 +154,56 @@ test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace:
     }
     p
 } {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
-test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {
+test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} -body {
+    variable result
     namespace eval test_ns_var {
 	variable result
         namespace eval subns {
 	    variable foo 2
 	}
 	upvar 0 subns::foo foo
-	lappend result [catch {set foo} msg] $msg
+	lappend [namespace parent]::result [catch {set foo} msg] $msg
         namespace delete subns
-	lappend result [catch {set foo 3} msg] $msg
-	lappend result [catch {set foo(3) 3} msg] $msg
+	lappend [namespace parent]::result [catch {set foo 3} msg] $msg
+	lappend [namespace parent]::result [catch {set foo(3) 3} msg] $msg
         namespace delete [namespace current]
-	set result
     }
-} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
+    set result
+} -cleanup {
+    unset result
+} -result {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
+
 test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
+    variable result {}
     namespace eval test_ns_var {
-	variable result
 	proc p {} {
 	    array set x {1 2 3 4}
 	    upvar 0 x(1) foo
-	    lappend result [catch {set foo} msg] $msg
+	    lappend [namespace parent]::result [catch {set foo} msg] $msg
 	    unset x
-	    lappend result [catch {set foo 3} msg] $msg
+	    lappend [namespace parent]::result [catch {set foo 3} msg] $msg
 	}
 	set result [p]
         namespace delete [namespace current]
-	set result
     }
+    set result
 } {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
 test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
     unset -nocomplain test_ns_var::x
 } -body {
+    variable result {}
     namespace eval test_ns_var {
-	variable result {}
 	variable x
 	array set x {1 2 3 4}
 	upvar 0 x(1) foo
-	lappend result [catch {set foo} msg] $msg
+	lappend [namespace parent]::result [catch {set foo} msg] $msg
 	unset x
-	lappend result [catch {set foo 3} msg] $msg
+	lappend [namespace parent]::result [catch {set foo 3} msg] $msg
         namespace delete [namespace current]
-	set result
     }
+    set result
+} -cleanup {
+    unset result
 } -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
 test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
     [format set] thisvar(doesntexist)
@@ -1457,7 +1463,72 @@ test var-24.24 {array default unset: errors} -setup {
 } -returnCodes error -cleanup {
     unset -nocomplain ary
 } -result * -match glob
+
+
+test var-25.0 {Look up command from deleted namespace} -body {
+    variable msg
+    set result [namespace eval test_ns_var {
+        namespace delete [namespace current]
+	# Doesn't result in a panic with message called Tcl_FindHashEntry on
+	# deleted table when Tcl_FindCommand is called to find resolve "catch"  
+	catch {lindex success} [namespace parent]::msg
+    }]
+    list $result $msg
+}  -result {0 success} 
+
+test var-25.1 {set a variable after deleting current namespace} {
+    variable msg {}
+    set result [namespace eval test_ns_var {
+	variable var1
+        namespace delete [namespace current]
+	set var1 one
+	namespace which -variable var1
+    }]
+} {::var1}
+
+test var-25.3 {The current namespace after deleting the current namespace} {
+    variable msg {}
+    namespace eval test_ns_var {
+	variable var1
+        namespace delete [namespace current]
+	namespace current
+    }
+} :: 
+
+test var-25.4 {
+    declare a namespace variable after deleting the current namespace
+} {
+    variable msg {}
+    namespace eval test_ns_var {
+	variable var1
+        namespace delete [namespace current]
+	variable var1
+	set var1 one
+	namespace which -variable var1
+    }
+} {::var1}
+
+test var-25.5 {
+    create a procedure after deleting the current namespace
+} {
+    namespace eval test_ns_var {
+        namespace delete [namespace current]
+	proc p1 {} {return hello}
+	list [namespace which p1] [p1]
+    } $msg
+} {::p1 hello}
+
+test var-25.6 {
+    create a namespace after deleting the current namespace
+} {
+    namespace eval test_ns_var {
+        namespace delete [namespace current]
+	namespace eval one {namespace current}
+    }
+} {::one}
+
 
+
 catch {namespace delete ns}
 catch {unset arr}
 catch {unset v}

unix/Makefile.in

@@ -786,7 +786,7 @@ test-tcl: ${TCLTEST_EXE}
 gdb-test: ${TCLTEST_EXE}
 	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
 	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
-	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
+	@echo "set args $(TOP_DIR)/tests/all.tcl $${TESTFLAGS} -singleproc 1" >> gdb.run
 	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
 	@rm gdb.run