From 5d8d3fcace7029ada82a3ac3cdc7f9afdd19bb9f Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 9 Aug 2006 13:51:02 +0000
Subject: Fix silly error in error handling for uncompiled [dict for]. [Bug
 1531184]

---
 ChangeLog            |  3 +++
 generic/tclDictObj.c | 22 +++++++++++-----------
 tests/dict.test      |  5 ++++-
 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...
 
-- 
cgit v0.12