1 files changed, 30 insertions, 193 deletions

diff --git a/generic/tclVar.c b/generic/tclVar.c
index 4694cd8..f93de3b 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -215,9 +215,9 @@ static Tcl_SetFromAnyProc	PanicOnSetVarName;
  * Types of Tcl_Objs used to cache variable lookups.
  *
  * localVarName - INTERNALREP DEFINITION:
- *   ptrAndLongRep.ptr:   pointer to name obj in varFramePtr->localCache
+ *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
  *			  or NULL if it is this same obj
- *   ptrAndLongRep.value: index into locals table
+ *   twoPtrValue.ptr2: index into locals table
  *
  * nsVarName - INTERNALREP DEFINITION:
  *   twoPtrValue.ptr1:	pointer to the namespace containing the reference
@@ -235,25 +235,6 @@ static const Tcl_ObjType localVarNameType = {
     FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
 };
 
-/*
- * Caching of namespace variables disabled: no simple way was found to avoid
- * interfering with the resolver's idea of variable existence. A cached
- * varName may keep a variable's name in the namespace's hash table, which is
- * the resolver's criterion for existence (see test namespace-17.10).
- */
-
-#define ENABLE_NS_VARNAME_CACHING 0
-
-#if ENABLE_NS_VARNAME_CACHING
-static Tcl_FreeInternalRepProc FreeNsVarName;
-static Tcl_DupInternalRepProc DupNsVarName;
-
-static const Tcl_ObjType tclNsVarNameType = {
-    "namespaceVarName",
-    FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName
-};
-#endif
-
 static const Tcl_ObjType tclParsedVarNameType = {
     "parsedVarName",
     FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
@@ -554,32 +535,15 @@ TclObjLookupVarEx(
     const Tcl_ObjType *typePtr = part1Ptr->typePtr;
     const char *errMsg = NULL;
     CallFrame *varFramePtr = iPtr->varFramePtr;
-#if ENABLE_NS_VARNAME_CACHING
-    Namespace *nsPtr;
-#endif
     const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
     char *newPart2 = NULL;
-
     *arrayPtrPtr = NULL;
 
-#if ENABLE_NS_VARNAME_CACHING
-    if (varFramePtr) {
-	nsPtr = varFramePtr->nsPtr;
-    } else {
-	/*
-	 * Some variables in the global ns have to be initialized before the
-	 * root call frame is in place.
-	 */
-
-	nsPtr = NULL;
-    }
-#endif
-
     if (typePtr == &localVarNameType) {
 	int localIndex;
 
     localVarNameTypeHandling:
-	localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
+	localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
 	if (HasLocalVars(varFramePtr)
 		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
 		&& (localIndex < varFramePtr->numCompiledLocals)) {
@@ -587,7 +551,7 @@ TclObjLookupVarEx(
 	     * Use the cached index if the names coincide.
 	     */
 
-	    Tcl_Obj *namePtr = part1Ptr->internalRep.ptrAndLongRep.ptr;
+	    Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1;
 	    Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);
 
 	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
@@ -597,44 +561,6 @@ TclObjLookupVarEx(
 	    }
 	}
 	goto doneParsing;
-#if ENABLE_NS_VARNAME_CACHING
-    } else if (typePtr == &tclNsVarNameType) {
-	int useGlobal, useReference;
-	Namespace *cachedNsPtr = part1Ptr->internalRep.twoPtrValue.ptr1;
-	varPtr = part1Ptr->internalRep.twoPtrValue.ptr2;
-
-	useGlobal = (cachedNsPtr == iPtr->globalNsPtr) && (
-		(flags & TCL_GLOBAL_ONLY) ||
-		(part1[0]==':' && part1[1]==':') ||
-		(!HasLocalVars(varFramePtr) && (nsPtr==iPtr->globalNsPtr)));
-
-	useReference = useGlobal || ((cachedNsPtr == nsPtr) && (
-		(flags & TCL_NAMESPACE_ONLY) ||
-		(!HasLocalVars(varFramePtr) && !(flags & TCL_GLOBAL_ONLY) &&
-		/*
-		 * Careful: an undefined ns variable could be hiding a valid
-		 * global reference.
-		 */
-		!TclIsVarUndefined(varPtr))));
-
-	if (useReference && !TclIsVarDeadHash(varPtr)) {
-	    /*
-	     * A straight global or namespace reference, use it. It isn't so
-	     * simple to deal with 'implicit' namespace references, i.e.,
-	     * those where the reference could be to either a namespace or a
-	     * global variable. Those we lookup again.
-	     *
-	     * If TclIsVarDeadHash(varPtr), this might be a reference to a
-	     * variable in a deleted namespace, kept alive by e.g. part1Ptr.
-	     * We could conceivably be so unlucky that a new namespace was
-	     * created at the same address as the deleted one, so to be safe
-	     * we test for a valid hPtr.
-	     */
-
-	    goto donePart1;
-	}
-	goto doneParsing;
-#endif
     }
 
     /*
@@ -674,7 +600,7 @@ TclObjLookupVarEx(
     }
     part1 = TclGetStringFromObj(part1Ptr, &len1);
 
-    if (!parsed && (*(part1 + len1 - 1) == ')')) {
+    if (!parsed && len1 && (*(part1 + len1 - 1) == ')')) {
 	/*
 	 * part1Ptr is possibly an unparsed array element.
 	 */
@@ -774,28 +700,14 @@ TclObjLookupVarEx(
 
 	part1Ptr->typePtr = &localVarNameType;
 	if (part1Ptr != localName(iPtr->varFramePtr, index)) {
-	    part1Ptr->internalRep.ptrAndLongRep.ptr =
+	    part1Ptr->internalRep.twoPtrValue.ptr1 =
 		    localName(iPtr->varFramePtr, index);
 	    Tcl_IncrRefCount((Tcl_Obj *)
-		    part1Ptr->internalRep.ptrAndLongRep.ptr);
+		    part1Ptr->internalRep.twoPtrValue.ptr1);
 	} else {
-	    part1Ptr->internalRep.ptrAndLongRep.ptr = NULL;
+	    part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
 	}
-	part1Ptr->internalRep.ptrAndLongRep.value = (long) index;
-#if ENABLE_NS_VARNAME_CACHING
-    } else if (index > -3) {
-	/*
-	 * A cacheable namespace or global variable.
-	 */
-
-	Namespace *nsPtr;
-
-	nsPtr = ((index == -1) ? iPtr->globalNsPtr : varFramePtr->nsPtr);
-	varPtr->refCount++;
-	part1Ptr->typePtr = &tclNsVarNameType;
-	part1Ptr->internalRep.twoPtrValue.ptr1 = nsPtr;
-	part1Ptr->internalRep.twoPtrValue.ptr2 = varPtr;
-#endif
+	part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
     } else {
 	/*
 	 * At least mark part1Ptr as already parsed.
@@ -807,18 +719,6 @@ TclObjLookupVarEx(
     }
 
   donePart1:
-#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
-    if (varPtr == NULL) {
-	if (flags & TCL_LEAVE_ERR_MSG) {
-	    part1 = TclGetString(part1Ptr);
-	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
-		    "cached variable reference is NULL.", -1);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
-		    TclGetString(part1Ptr), NULL);
-	}
-	return NULL;
-    }
-#endif
     while (TclIsVarLink(varPtr)) {
 	varPtr = varPtr->value.linkPtr;
     }
@@ -1912,17 +1812,6 @@ TclPtrSetVar(
 	varPtr->value.objPtr = NULL;
     }
     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
-#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
-	/*
-	 * Can't happen now!
-	 */
-
-	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
-	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
-	    varPtr->value.objPtr = NULL;
-	    oldValuePtr = NULL;
-	}
-#endif
 	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
 	    if (oldValuePtr == NULL) {
 		TclNewObj(oldValuePtr);
@@ -1958,6 +1847,9 @@ TclPtrSetVar(
 		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
 		}
 		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
+		if (newValuePtr->refCount == 0) {
+		    Tcl_DecrRefCount(newValuePtr);
+		}
 	    }
 	}
     } else if (newValuePtr != oldValuePtr) {
@@ -2385,18 +2277,6 @@ TclPtrUnsetVar(
 	}
     }
 
-#if ENABLE_NS_VARNAME_CACHING
-    /*
-     * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType
-     * keeping a reference. This removes some additional exteriorisations of
-     * [Bug 736729], but may be a good thing independently of the bug.
-     */
-
-    if (part1Ptr->typePtr == &tclNsVarNameType) {
-	TclFreeIntRep(part1Ptr);
-    }
-#endif
-
     /*
      * Finally, if the variable is truly not in use then free up its Var
      * structure and remove it from its hash table, if any. The ref count of
@@ -2514,8 +2394,8 @@ UnsetVarStruct(
 	    tracePtr = NULL;
 	    if (TclIsVarTraced(&dummyVar)) {
 		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar);
-		tracePtr = Tcl_GetHashValue(tPtr);
 		if (tPtr) {
+		    tracePtr = Tcl_GetHashValue(tPtr);
 		    Tcl_DeleteHashEntry(tPtr);
 		}
 	    }
@@ -4402,8 +4282,8 @@ ObjMakeUpvar(
 			|| !HasLocalVars(varFramePtr)
 			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
 	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
-		    "bad variable name \"%s\": upvar won't create "
-		    "namespace variable that refers to procedure variable",
+		    "bad variable name \"%s\": can't create namespace "
+		    "variable that refers to procedure variable",
 		    TclGetString(myNamePtr)));
 	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
 	    return TCL_ERROR;
@@ -4503,9 +4383,8 @@ TclPtrObjMakeUpvar(
 		 */
 
 		Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
-			"bad variable name \"%s\": upvar won't create a"
-			" scalar variable that looks like an array element",
-			myName));
+			"bad variable name \"%s\": can't create a scalar "
+			"variable that looks like an array element", myName));
 		Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
 			NULL);
 		return TCL_ERROR;
@@ -4744,7 +4623,7 @@ Tcl_GetVariableFullName(
     } else if (iPtr->varFramePtr->procPtr) {
 	int index = varPtr - iPtr->varFramePtr->compiledLocals;
 
-	if (index < iPtr->varFramePtr->numCompiledLocals) {
+	if (index >= 0 && index < iPtr->varFramePtr->numCompiledLocals) {
 	    namePtr = localName(iPtr->varFramePtr, index);
 	    Tcl_AppendObjToObj(objPtr, namePtr);
 	}
@@ -5661,16 +5540,16 @@ PanicOnSetVarName(
  * localVarName -
  *
  * INTERNALREP DEFINITION:
- *   ptrAndLongRep.ptr:   pointer to name obj in varFramePtr->localCache
+ *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
  *			  or NULL if it is this same obj
- *   ptrAndLongRep.value: index into locals table
+ *   twoPtrValue.ptr2: index into locals table
  */
 
 static void
 FreeLocalVarName(
     Tcl_Obj *objPtr)
 {
-    Tcl_Obj *namePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+    Tcl_Obj *namePtr = objPtr->internalRep.twoPtrValue.ptr1;
 
     if (namePtr) {
 	Tcl_DecrRefCount(namePtr);
@@ -5683,60 +5562,19 @@ DupLocalVarName(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dupPtr)
 {
-    Tcl_Obj *namePtr = srcPtr->internalRep.ptrAndLongRep.ptr;
+    Tcl_Obj *namePtr = srcPtr->internalRep.twoPtrValue.ptr1;
 
     if (!namePtr) {
 	namePtr = srcPtr;
     }
-    dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
+    dupPtr->internalRep.twoPtrValue.ptr1 = namePtr;
     Tcl_IncrRefCount(namePtr);
 
-    dupPtr->internalRep.ptrAndLongRep.value =
-	    srcPtr->internalRep.ptrAndLongRep.value;
+    dupPtr->internalRep.twoPtrValue.ptr2 =
+	    srcPtr->internalRep.twoPtrValue.ptr2;
     dupPtr->typePtr = &localVarNameType;
 }
 
-#if ENABLE_NS_VARNAME_CACHING
-/*
- * nsVarName -
- *
- * INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1: pointer to the namespace containing the reference.
- *   twoPtrValue.ptr2: pointer to the corresponding Var
- */
-
-static void
-FreeNsVarName(
-    Tcl_Obj *objPtr)
-{
-    register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2;
-
-    if (TclIsVarInHash(varPtr)) {
-	varPtr->refCount--;
-	if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
-	    CleanupVar(varPtr, NULL);
-	}
-    }
-    objPtr->typePtr = NULL;
-}
-
-static void
-DupNsVarName(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *dupPtr)
-{
-    Namespace *nsPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-    register Var *varPtr = srcPtr->internalRep.twoPtrValue.ptr2;
-
-    dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr;
-    dupPtr->internalRep.twoPtrValue.ptr2 = varPtr;
-    if (TclIsVarInHash(varPtr)) {
-	varPtr->refCount++;
-    }
-    dupPtr->typePtr = &tclNsVarNameType;
-}
-#endif
-
 /*
  * parsedVarName -
  *
@@ -6526,12 +6364,11 @@ CompareVarKeys(
 
     /*
      * If the object pointers are the same then they match.
-     */
-
-    if (objPtr1 == objPtr2) {
-	return 1;
-    }
-
+     * OPT: this comparison was moved to the caller
+     
+       if (objPtr1 == objPtr2) return 1;
+    */
+    
     /*
      * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
      * register.