summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog3
-rw-r--r--generic/tclDictObj.c22
-rw-r--r--tests/dict.test5
3 files changed, 18 insertions, 12 deletions
diff --git a/ChangeLog b/ChangeLog
index 0548685..dc9efa3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
2006-08-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+ * generic/tclDictObj.c (DictForCmd): Stop crash when attempting to
+ iterate over an invalid dictionary. [Bug 1531184]
+
* doc/ParseCmd.3, doc/expr.n, doc/set.n, doc/subst.n, doc/switch.n:
* doc/tclvars.n: Ensure that uses of [expr] in documentation examples
are also good style (with braces) unless otherwise necessary. [Bug
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 12907db..390c66f 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.39 2005/11/04 22:38:38 msofer Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.40 2006/08/09 13:51:02 dkf Exp $
*/
#include "tclInt.h"
@@ -2182,6 +2182,11 @@ DictForCmd(
valueVarObj = varv[1];
scriptObj = objv[4];
+ if (Tcl_DictObjFirst(interp, objv[3], &search, &keyObj, &valueObj,
+ &done) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
/*
* Make sure that these objects (which we need throughout the body of the
* loop) don't vanish. Note that the dictionary internal rep is locked
@@ -2192,12 +2197,7 @@ DictForCmd(
Tcl_IncrRefCount(valueVarObj);
Tcl_IncrRefCount(scriptObj);
- result = Tcl_DictObjFirst(interp, objv[3],
- &search, &keyObj, &valueObj, &done);
- if (result != TCL_OK) {
- goto doneFor;
- }
-
+ result = TCL_OK;
while (!done) {
/*
* Stop the value from getting hit in any way by any traces on the key
@@ -2211,7 +2211,7 @@ DictForCmd(
TclGetString(keyVarObj), "\"", NULL);
TclDecrRefCount(valueObj);
result = TCL_ERROR;
- goto doneFor;
+ break;
}
TclDecrRefCount(valueObj);
if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
@@ -2219,7 +2219,7 @@ DictForCmd(
Tcl_AppendResult(interp, "couldn't set value variable: \"",
TclGetString(valueVarObj), "\"", NULL);
result = TCL_ERROR;
- goto doneFor;
+ break;
}
result = Tcl_EvalObjEx(interp, scriptObj, 0);
@@ -2230,7 +2230,8 @@ DictForCmd(
result = TCL_OK;
} else if (result == TCL_ERROR) {
TclFormatToErrorInfo(interp,
- "\n (\"dict for\" body line %d)", interp->errorLine);
+ "\n (\"dict for\" body line %d)",
+ interp->errorLine);
}
break;
}
@@ -2238,7 +2239,6 @@ DictForCmd(
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
- doneFor:
/*
* Stop holding a reference to these objects.
*/
diff --git a/tests/dict.test b/tests/dict.test
index 79bce48..cf9fc1f 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: dict.test,v 1.18 2006/01/18 19:48:11 dgp Exp $
+# RCS: @(#) $Id: dict.test,v 1.19 2006/08/09 13:51:02 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -559,6 +559,9 @@ test dict-14.18 {dict for command in compilation context} {
}
dicttest
} 1
+test dict-14.19 {dict for and invalid dicts: bug 1531184} -body {
+ di[list]ct for {k v} x {}
+} -returnCodes 1 -result {missing value to go with key}
# There's probably a lot more tests to add here. Really ought to use a
# coverage tool for this job...