diff options
| -rw-r--r-- | ChangeLog | 3 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 22 | ||||
| -rw-r--r-- | tests/dict.test | 5 |
3 files changed, 18 insertions, 12 deletions
@@ -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... |