1 files changed, 181 insertions, 104 deletions

diff --git a/generic/tclVar.c b/generic/tclVar.c
index e31e9cf..0228a2c 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -47,6 +47,13 @@ static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);
 #define VarHashGetValue(hPtr) \
     ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
 
+/*
+ * NOTE: VarHashCreateVar increments the recount of its key argument.
+ * All callers that will call Tcl_DecrRefCount on that argument must
+ * call Tcl_IncrRefCount on it before passing it in.  This requirement
+ * can bubble up to callers of callers .... etc.
+ */
+
 static inline Var *
 VarHashCreateVar(
     TclVarHashTable *tablePtr,
@@ -137,6 +144,30 @@ static const char *isArrayElement =
 #define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
 
 /*
+ * The following structure describes an enumerative search in progress on an
+ * array variable; this are invoked with options to the "array" command.
+ */
+
+typedef struct ArraySearch {
+    int id;			/* Integer id used to distinguish among
+				 * multiple concurrent searches for the same
+				 * array. */
+    struct Var *varPtr;		/* Pointer to array variable that's being
+				 * searched. */
+    Tcl_HashSearch search;	/* Info kept by the hash module about progress
+				 * through the array. */
+    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element to
+				 * be enumerated (it's leftover from the
+				 * Tcl_FirstHashEntry call or from an "array
+				 * anymore" command). NULL means must call
+				 * Tcl_NextHashEntry to get value to
+				 * return. */
+    struct ArraySearch *nextPtr;/* Next in list of all active searches for
+				 * this variable, or NULL if this is the last
+				 * one. */
+} ArraySearch;
+
+/*
  * Forward references to functions defined later in this file:
  */
 
@@ -383,11 +414,12 @@ TclLookupVar(
 				 * address of array variable. Otherwise this
 				 * is set to NULL. */
 {
-    Tcl_Obj *part1Ptr;
     Var *varPtr;
+    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
+    if (createPart1) {
+	Tcl_IncrRefCount(part1Ptr);
+    }
 
     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
 	    createPart1, createPart2, arrayPtrPtr);
@@ -432,6 +464,8 @@ TclLookupVar(
  *	are 1. The object part1Ptr is converted to one of localVarNameType,
  *	tclNsVarNameType or tclParsedVarNameType and caches as much of the
  *	lookup as it can.
+ *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ *	plan to DecrRefCount it.
  *
  *----------------------------------------------------------------------
  */
@@ -460,14 +494,14 @@ TclObjLookupVar(
 				 * address of array variable. Otherwise this
 				 * is set to NULL. */
 {
-    Tcl_Obj *part2Ptr;
+    Tcl_Obj *part2Ptr = NULL;
     Var *resPtr;
 
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
+	if (createPart2) {
+	    Tcl_IncrRefCount(part2Ptr);
+	}
     }
 
     resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
@@ -480,6 +514,12 @@ TclObjLookupVar(
     return resPtr;
 }
 
+/*
+ *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ *	plan to DecrRefCount it.
+ *	When createPart2 is 1, callers must IncrRefCount part2Ptr if they
+ *	plan to DecrRefCount it.
+ */
 Var *
 TclObjLookupVarEx(
     Tcl_Interp *interp,		/* Interpreter to use for lookup. */
@@ -620,7 +660,9 @@ TclObjLookupVarEx(
 	    part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
 	    if (newPart2) {
 		part2Ptr = Tcl_NewStringObj(newPart2, -1);
-		Tcl_IncrRefCount(part2Ptr);
+		if (createPart2) {
+		    Tcl_IncrRefCount(part2Ptr);
+		}
 	    }
 	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
 	    typePtr = part1Ptr->typePtr;
@@ -666,7 +708,9 @@ TclObjLookupVarEx(
 		*(newPart2+len2) = '\0';
 		part2 = newPart2;
 		part2Ptr = Tcl_NewStringObj(newPart2, -1);
-		Tcl_IncrRefCount(part2Ptr);
+		if (createPart2) {
+		    Tcl_IncrRefCount(part2Ptr);
+		}
 
 		/*
 		 * Free the internal rep of the original part1Ptr, now renamed
@@ -847,6 +891,7 @@ TclObjLookupVarEx(
  *
  * Side effects:
  *	A new hashtable entry may be created if create is 1.
+ *	Callers must Incr varNamePtr if they plan to Decr it if create is 1.
  *
  *----------------------------------------------------------------------
  */
@@ -1075,6 +1120,8 @@ TclLookupSimpleVar(
  *	The variable at arrayPtr may be converted to be an array if
  *	createPart1 is 1. A new hashtable entry may be created if createPart2
  *	is 1.
+ *	When createElem is 1, callers must incr elNamePtr if they plan
+ *	to decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -1200,6 +1247,7 @@ TclLookupArrayElement(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_GetVar
 const char *
 Tcl_GetVar(
     Tcl_Interp *interp,		/* Command interpreter in which varName is to
@@ -1209,11 +1257,9 @@ Tcl_GetVar(
 				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
 				 * bits. */
 {
-    Tcl_Obj *varNamePtr, *resultPtr;
+    Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1);
+    Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags);
 
-    varNamePtr = Tcl_NewStringObj(varName, -1);
-    Tcl_IncrRefCount(varNamePtr);
-    resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags);
     TclDecrRefCount(varNamePtr);
 
     if (resultPtr == NULL) {
@@ -1257,15 +1303,12 @@ Tcl_GetVar2(
 				 * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG *
 				 * bits. */
 {
-    Tcl_Obj *resultPtr, *part1Ptr, *part2Ptr;
+    Tcl_Obj *resultPtr;
+    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
 	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
     }
 
     resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1314,15 +1357,11 @@ Tcl_GetVar2Ex(
     int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
 				 * TCL_LEAVE_ERR_MSG bits. */
 {
-    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
+    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
 	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
     }
 
     resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1355,6 +1394,8 @@ Tcl_GetVar2Ex(
  *	the returned reference; if you want to keep a reference to the object
  *	you must increment its ref count yourself.
  *
+ *	Callers must incr part2Ptr if they plan to decr it.
+ *
  *----------------------------------------------------------------------
  */
 
@@ -1549,6 +1590,7 @@ Tcl_SetObjCmd(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_SetVar
 const char *
 Tcl_SetVar(
     Tcl_Interp *interp,		/* Command interpreter in which varName is to
@@ -1560,17 +1602,13 @@ Tcl_SetVar(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Tcl_Obj *valuePtr, *varNamePtr, *varValuePtr;
+    Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1);
 
-    varNamePtr = Tcl_NewStringObj(varName, -1);
     Tcl_IncrRefCount(varNamePtr);
-    valuePtr = Tcl_NewStringObj(newValue, -1);
-    Tcl_IncrRefCount(valuePtr);
-
-    varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, valuePtr, flags);
-
+    varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, 
+	    Tcl_NewStringObj(newValue, -1), flags);
     Tcl_DecrRefCount(varNamePtr);
-    Tcl_DecrRefCount(valuePtr);
+
     if (varValuePtr == NULL) {
 	return NULL;
     }
@@ -1618,27 +1656,9 @@ Tcl_SetVar2(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Tcl_Obj *valuePtr, *part1Ptr, *part2Ptr;
-    Tcl_Obj *varValuePtr;
+    Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
+	    Tcl_NewStringObj(newValue, -1), flags);
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
-    if (part2 != NULL) {
-	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
-    }
-    valuePtr = Tcl_NewStringObj(newValue, -1);
-    Tcl_IncrRefCount(valuePtr);
-
-    varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr, flags);
-
-    Tcl_DecrRefCount(part1Ptr);
-    if (part2Ptr != NULL) {
-	Tcl_DecrRefCount(part2Ptr);
-    }
-    Tcl_DecrRefCount(valuePtr);
     if (varValuePtr == NULL) {
 	return NULL;
     }
@@ -1697,15 +1717,12 @@ Tcl_SetVar2Ex(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
+    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
 	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
     }
 
     resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
@@ -1738,6 +1755,8 @@ Tcl_SetVar2Ex(
  * Side effects:
  *	The value of the given variable is set. If either the array or the
  *	entry didn't exist then a new variable is created.
+ *	Callers must Incr part1Ptr if they plan to Decr it.
+ *	Callers must Incr part2Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -1939,6 +1958,9 @@ TclPtrSetVar(
 		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
 		}
 		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
+		if (newValuePtr->refCount == 0) {
+		    Tcl_DecrRefCount(newValuePtr);
+		}
 	    }
 	}
     } else if (newValuePtr != oldValuePtr) {
@@ -2027,6 +2049,8 @@ TclPtrSetVar(
  *	variable is created. The ref count for the returned object is _not_
  *	incremented to reflect the returned reference; if you want to keep a
  *	reference to the object you must increment its ref count yourself.
+ *	Callers must Incr part1Ptr if they plan to Decr it.
+ *	Callers must Incr part2Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -2052,8 +2076,8 @@ TclIncrObjVar2(
     varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
 	    1, 1, &arrayPtr);
     if (varPtr == NULL) {
-	Tcl_AddObjErrorInfo(interp,
-		"\n    (reading value of variable to increment)", -1);
+	Tcl_AddErrorInfo(interp,
+		"\n    (reading value of variable to increment)");
 	return NULL;
     }
     return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
@@ -2109,8 +2133,7 @@ TclPtrIncrObjVar(
 				 * variable, or -1. Only used when part1Ptr is
 				 * NULL. */
 {
-    register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
-    int duplicated, code;
+    register Tcl_Obj *varValuePtr;
 
     if (TclIsVarInHash(varPtr)) {
 	VarHashRefCount(varPtr)++;
@@ -2124,19 +2147,33 @@ TclPtrIncrObjVar(
 	varValuePtr = Tcl_NewIntObj(0);
     }
     if (Tcl_IsShared(varValuePtr)) {
-	duplicated = 1;
+	/* Copy on write */
 	varValuePtr = Tcl_DuplicateObj(varValuePtr);
+	
+	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+		    varValuePtr, flags, index);
+	} else {
+	    Tcl_DecrRefCount(varValuePtr);
+	    return NULL;
+	}
     } else {
-	duplicated = 0;
-    }
-    code = TclIncrObj(interp, varValuePtr, incrPtr);
-    if (code == TCL_OK) {
-	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
-		part2Ptr, varValuePtr, flags, index);
-    } else if (duplicated) {
-	Tcl_DecrRefCount(varValuePtr);
+	/* Unshared - can Incr in place */
+	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+
+	    /*
+	     * This seems dumb to write the incremeted value into the var
+	     * after we just adjusted the value in place, but the spec for
+	     * [incr] requires that write traces fire, and making this call
+	     * is the way to make that happen.
+	     */
+
+	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+		    varValuePtr, flags, index);
+	} else {
+	    return NULL;
+	}
     }
-    return newValuePtr;
 }
 
 /*
@@ -2159,6 +2196,7 @@ TclPtrIncrObjVar(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_UnsetVar
 int
 Tcl_UnsetVar(
     Tcl_Interp *interp,		/* Command interpreter in which varName is to
@@ -2219,13 +2257,10 @@ Tcl_UnsetVar2(
 				 * TCL_LEAVE_ERR_MSG. */
 {
     int result;
-    Tcl_Obj *part1Ptr, *part2Ptr = NULL;
+    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
     }
 
     /*
@@ -2841,6 +2876,7 @@ Tcl_LappendObjCmd(
  *
  * Side effects:
  *	A variable will be created if one does not already exist.
+ *	Callers must Incr arrayNameObj if they pland to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -3817,6 +3853,53 @@ ArrayNamesCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclFindArrayPtrElements --
+ *
+ *	Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry
+ *	for each existing element of the given array. The provided hash table
+ *	is assumed to be initially empty.
+ *
+ * Result:
+ *	none
+ *
+ * Side effects:
+ *	The keys of the array gain an extra reference. The supplied hash table
+ *	has elements added to it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFindArrayPtrElements(
+    Var *arrayPtr,
+    Tcl_HashTable *tablePtr)
+{
+    Var *varPtr;
+    Tcl_HashSearch search;
+
+    if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr)
+	    || TclIsVarUndefined(arrayPtr)) {
+	return;
+    }
+
+    for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search);
+	    varPtr!=NULL ; varPtr=VarHashNextVar(&search)) {
+	Tcl_HashEntry *hPtr;
+	Tcl_Obj *nameObj;
+	int dummy;
+
+	if (TclIsVarUndefined(varPtr)) {
+	    continue;
+	}
+	nameObj = VarHashGetKey(varPtr);
+	hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy);
+	Tcl_SetHashValue(hPtr, nameObj);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * ArraySetCmd --
  *
  *	This object-based function is invoked to process the "array set" Tcl
@@ -4222,17 +4305,17 @@ TclInitArrayCmd(
     Tcl_Interp *interp)		/* Current interpreter. */
 {
     static const EnsembleImplMap arrayImplMap[] = {
-	{"anymore",	ArrayAnyMoreCmd,	NULL, NULL, NULL, 0},
-	{"donesearch",	ArrayDoneSearchCmd,	NULL, NULL, NULL, 0},
-	{"exists",	ArrayExistsCmd,		NULL, NULL, NULL, 0},
-	{"get",		ArrayGetCmd,		NULL, NULL, NULL, 0},
-	{"names",	ArrayNamesCmd,		NULL, NULL, NULL, 0},
-	{"nextelement",	ArrayNextElementCmd,	NULL, NULL, NULL, 0},
-	{"set",		ArraySetCmd,		NULL, NULL, NULL, 0},
-	{"size",	ArraySizeCmd,		NULL, NULL, NULL, 0},
-	{"startsearch",	ArrayStartSearchCmd,	NULL, NULL, NULL, 0},
-	{"statistics",	ArrayStatsCmd,		NULL, NULL, NULL, 0},
-	{"unset",	ArrayUnsetCmd,		NULL, NULL, NULL, 0},
+	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
+	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
+	{"size",	ArraySizeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"unset",	ArrayUnsetCmd,		TclCompileArrayUnsetCmd, NULL, NULL, 0},
 	{NULL, NULL, NULL, NULL, NULL, 0}
     };
 
@@ -4255,6 +4338,8 @@ TclInitArrayCmd(
  *	The variable given by myName is linked to the variable in framePtr
  *	given by otherP1 and otherP2, so that references to myName are
  *	redirected to the other variable like a symbolic link.
+ *	Callers must Incr myNamePtr if they plan to Decr it.
+ *	Callers must Incr otherP1Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -4320,8 +4405,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;
@@ -4363,14 +4448,12 @@ TclPtrMakeUpvar(
     int index)			/* If the variable to be linked is an indexed
 				 * scalar, this is its index. Otherwise, -1 */
 {
-    Tcl_Obj *myNamePtr;
+    Tcl_Obj *myNamePtr = NULL;
     int result;
 
     if (myName) {
 	myNamePtr = Tcl_NewStringObj(myName, -1);
 	Tcl_IncrRefCount(myNamePtr);
-    } else {
-	myNamePtr = NULL;
     }
     result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
     if (myNamePtr) {
@@ -4379,6 +4462,8 @@ TclPtrMakeUpvar(
     return result;
 }
 
+/* Callers must Incr myNamePtr if they plan to Decr it. */
+ 
 int
 TclPtrObjMakeUpvar(
     Tcl_Interp *interp,		/* Interpreter containing variables. Used for
@@ -4421,9 +4506,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;
@@ -4518,6 +4602,7 @@ TclPtrObjMakeUpvar(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_UpVar
 int
 Tcl_UpVar(
     Tcl_Interp *interp,		/* Command interpreter in which varName is to
@@ -4661,7 +4746,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);
 	}
@@ -5111,7 +5196,8 @@ ParseSearchId(
      * Parse the id.
      */
 
-    if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
+    if ((handleObj->typePtr != &tclArraySearchType)
+	    && (SetArraySearchObj(interp, handleObj) != TCL_OK)) {
 	return NULL;
     }
 
@@ -5242,8 +5328,6 @@ TclDeleteNamespaceVars(
     for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
 	    varPtr = VarHashFirstVar(tablePtr, &search)) {
 	Tcl_Obj *objPtr = Tcl_NewObj();
-
-	Tcl_IncrRefCount(objPtr);
 	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
 					 * hash. */
 	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
@@ -5507,15 +5591,10 @@ TclVarErrMsg(
 				 * e.g. "read", "set", or "unset". */
     const char *reason)		/* String describing why operation failed. */
 {
-    Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL;
+    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2 = NULL;
     }
 
     TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
@@ -5788,7 +5867,6 @@ Tcl_FindNamespaceVar(
     Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
     Tcl_Var var;
 
-    Tcl_IncrRefCount(namePtr);
     var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
     Tcl_DecrRefCount(namePtr);
     return var;
@@ -5883,7 +5961,6 @@ ObjFindNamespaceVar(
     varPtr = NULL;
     if (simpleName != name) {
 	simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
-	Tcl_IncrRefCount(simpleNamePtr);
     } else {
 	simpleNamePtr = namePtr;
     }