diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclVar.c | 10 | ||||
| -rw-r--r-- | tests/var.test | 14 |
3 files changed, 29 insertions, 2 deletions
@@ -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} |