More consistency in errorcode generation.

3 files changed, 29 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index 40b8a15..0ad5239 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
 2010-02-05  Donal K. Fellows  <dkf@users.sf.net>
 
+	* generic/tclVar.c: More consistency in errorcode generation.
+
 	* generic/tclOOBasic.c (TclOO_Object_Destroy): Rewrote to be NRE-aware
 	when calling destructors. Note that there is no guarantee that
 	destructors will always be called in an NRE context; that's a feature
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 1848fff..79409b4 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.194 2010/02/05 10:03:23 nijtmans Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.195 2010/02/05 14:33:09 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -713,7 +713,8 @@ TclObjLookupVarEx(
     if (varPtr == NULL) {
 	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
 	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		    TclGetString(part1Ptr), NULL);
 	}
 	if (newPart2) {
 	    Tcl_DecrRefCount(part2Ptr);
@@ -771,7 +772,8 @@ TclObjLookupVarEx(
 	    part1 = TclGetString(part1Ptr);
 	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
 		    "cached variable reference is NULL.", -1);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		    TclGetString(part1Ptr), NULL);
 	}
 	return NULL;
     }
@@ -1115,7 +1117,8 @@ TclLookupArrayElement(
 	    if (flags & TCL_LEAVE_ERR_MSG) {
 		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
 			noSuchVar, index);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
 	    }
 	    return NULL;
 	}
@@ -1129,7 +1132,8 @@ TclLookupArrayElement(
 	    if (flags & TCL_LEAVE_ERR_MSG) {
 		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
 			danglingVar, index);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
 	    }
 	    return NULL;
 	}
@@ -1148,7 +1152,8 @@ TclLookupArrayElement(
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
 		    index);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
 	}
 	return NULL;
     }
@@ -2863,7 +2868,8 @@ TclArraySet(
     if (arrayPtr) {
 	CleanupVar(varPtr, arrayPtr);
 	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		TclGetString(arrayNameObj), NULL);
 	return TCL_ERROR;
     }
 
@@ -3065,7 +3071,7 @@ ArrayStartSearchCmd(
     if ((varPtr == NULL) || !TclIsVarArray(varPtr)
 	    || TclIsVarUndefined(varPtr)) {
 	Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
 	return TCL_ERROR;
     }
 
@@ -3164,7 +3170,8 @@ ArrayAnyMoreCmd(
 	    || TclIsVarUndefined(varPtr)) {
 	Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
 		"\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+		TclGetString(varNameObj), NULL);
 	return TCL_ERROR;
     }
 
@@ -3269,7 +3276,8 @@ ArrayNextElementCmd(
 	    || TclIsVarUndefined(varPtr)) {
 	Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
 		"\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+		TclGetString(varNameObj), NULL);
 	return TCL_ERROR;
     }
 
@@ -3378,7 +3386,8 @@ ArrayDoneSearchCmd(
 	    || TclIsVarUndefined(varPtr)) {
 	Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
 		"\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+		TclGetString(varNameObj), NULL);
 	return TCL_ERROR;
     }
 
@@ -4020,7 +4029,8 @@ ArrayStatsCmd(
 	    || TclIsVarUndefined(varPtr)) {
 	Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
 		"\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+		TclGetString(varNameObj), NULL);
 	return TCL_ERROR;
     }
 
@@ -4438,7 +4448,8 @@ TclPtrObjMakeUpvar(
 		myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
 	if (varPtr == NULL) {
 	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		    TclGetString(myNamePtr), NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -5059,7 +5070,7 @@ SetArraySearchObj(
   syntax:
     Tcl_AppendResult(interp, "illegal search identifier \"", string, "\"",
 	    NULL);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", NULL);
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
     return TCL_ERROR;
 }
 
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 182d43b..f7ba584 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdAH.test,v 1.67 2009/12/28 12:55:48 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.68 2010/02/05 14:33:09 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -1051,7 +1051,7 @@ test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
 } -body {
     set x 44
     list [catch {file lstat $gorpfile x} msg] $msg $errorCode
-} -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME}}
+} -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}}
 catch {unset stat}
 # mkdir
 set dirA [file join [temporaryDirectory] a]