summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-02-02 00:42:41 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-02-02 00:42:41 (GMT)
commitc1534c208e4eee03061c52b2d7de3ded03f8de37 (patch)
tree6e29718539a83cd56321eb262b49a848eb9b3b31 /tests
parentf231dc527e35148e1fb38301a10ccb8614fd1c72 (diff)
downloadtcl-c1534c208e4eee03061c52b2d7de3ded03f8de37.zip
tcl-c1534c208e4eee03061c52b2d7de3ded03f8de37.tar.gz
tcl-c1534c208e4eee03061c52b2d7de3ded03f8de37.tar.bz2
Fix [Bug 2939073]: dangling ref when an unset trace triggered by [array unset]
hits the next element to be deleted.
Diffstat (limited to 'tests')
-rw-r--r--tests/var.test34
1 files changed, 29 insertions, 5 deletions
diff --git a/tests/var.test b/tests/var.test
index bf48224..c5c304e 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.31 2008/03/11 17:23:56 msofer Exp $
+# RCS: @(#) $Id: var.test,v 1.31.2.1 2010/02/02 00:42:41 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -34,7 +34,7 @@ catch {unset y}
catch {unset i}
catch {unset a}
catch {unset arr}
-
+
test var-1.1 {TclLookupVar, Array handling} {
catch {unset a}
set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd
@@ -716,9 +716,9 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
test var-16.1 {CallVarTraces: save/restore interp error state} {
- trace add variable ::errorCode write { ;#}
+ trace add variable ::errorCode write " ;#"
catch {error foo bar baz}
- trace remove variable ::errorCode write { ;#}
+ trace remove variable ::errorCode write " ;#"
set ::errorInfo
} bar
@@ -727,13 +727,33 @@ test var-17.1 {TclArraySet [Bug 1669489]} -setup {
} -body {
namespace eval :: {
set elements {1 2 3 4}
- trace add variable a write {string length $elements ;#}
+ trace add variable a write "string length \$elements ;#"
array set a $elements
}
} -cleanup {
unset -nocomplain ::a ::elements
} -result {}
+test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
+ set already 0
+ unset x
+} -body {
+ array set x {e 1 i 1}
+ trace add variable x unset {apply {args {
+ global already x
+ if {!$already} {
+ set already 1
+ unset x(i)
+ }
+ }}}
+ # The next command would crash reliably with memory debugging prior to the
+ # bug fix.
+ array unset x *
+ array size x
+} -cleanup {
+ unset x already
+} -result 0
+
catch {namespace delete ns}
catch {unset arr}
catch {unset v}
@@ -752,3 +772,7 @@ catch {unset aaaaa}
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: