* generic/tclVar.c (TclArraySet): Re-fetch pointers for the list

        * tests/var.test (var-17.1):    argument of [array set] each time
        through the loop as defense against possible shimmer issues.
        [Bug 1669489].

3 files changed, 29 insertions, 2 deletions

diff --git a/ChangeLog b/ChangeLog
index 06a6e5c..253c4e7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2007-03-13  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclVar.c (TclArraySet):	Re-fetch pointers for the list
+	* tests/var.test (var-17.1):	argument of [array set] each time
+	through the loop as defense against possible shimmer issues.
+	[Bug 1669489].
+
 2007-03-10  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Handle tricky case with loss
diff --git a/generic/tclVar.c b/generic/tclVar.c
index c0dfdc3..b8c608b 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,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.69.2.12 2006/10/05 11:44:03 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.69.2.13 2007/03/13 15:59:52 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3489,6 +3489,14 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
 		    result = TCL_ERROR;
 		    break;
 		}
+
+		/*
+		 * The TclPtrSetVar call might have shimmered
+		 * arrayElemObj to another type, so re-fetch
+		 * the pointers for safety.
+		 */
+		Tcl_ListObjGetElements(NULL, arrayElemObj,
+			&elemLen, &elemPtrs);
 	    }
 	    return result;
 	}
diff --git a/tests/var.test b/tests/var.test
index 64f52707..9f163e8 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -14,7 +14,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: var.test,v 1.20.2.3 2004/09/30 22:45:17 dgp Exp $
+# RCS: @(#) $Id: var.test,v 1.20.2.4 2007/03/13 15:59:53 dgp Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -701,6 +701,18 @@ test var-16.1 {CallVarTraces: save/restore interp error state: 1038021} {
     set errorInfo
 } bar
 
+test var-17.1 {TclArraySet [Bug 1669489]} -setup {
+    unset -nocomplain ::a
+} -body {
+    namespace eval :: {
+        set elements {1 2 3 4}
+        trace add variable a write {string length $elements ;#}
+        array set a $elements
+    }
+} -cleanup {
+    unset -nocomplain ::a ::elements
+} -result {}
+
 catch {namespace delete ns}
 catch {unset arr}
 catch {unset v}