summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-03-13 15:59:51 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-03-13 15:59:51 (GMT)
commita3ba8079a4c6747f3fd58413e35cd0e2d3adee3d (patch)
tree4d389b4a06d153cf1f155302bf79074e9fe3ee43
parent9b37ffdd3cd479883df0f3aacbd2e442b40fd5e4 (diff)
downloadtcl-a3ba8079a4c6747f3fd58413e35cd0e2d3adee3d.zip
tcl-a3ba8079a4c6747f3fd58413e35cd0e2d3adee3d.tar.gz
tcl-a3ba8079a4c6747f3fd58413e35cd0e2d3adee3d.tar.bz2
* 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].
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclVar.c10
-rw-r--r--tests/var.test14
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}