summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog2
-rw-r--r--generic/tclVar.c39
-rw-r--r--tests/cmdAH.test4
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]