summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-02-02 00:11:30 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-02-02 00:11:30 (GMT)
commita2138bd6664eaf8ec5a4dcf1b66a78ee9c9fa8f3 (patch)
tree6b1f1a1d72ac03c844a4d8bf2d0ba47401b0e28b /tests
parenta4eb99f2549d55277cc2803158db4bcbdc074a95 (diff)
downloadtcl-a2138bd6664eaf8ec5a4dcf1b66a78ee9c9fa8f3.zip
tcl-a2138bd6664eaf8ec5a4dcf1b66a78ee9c9fa8f3.tar.gz
tcl-a2138bd6664eaf8ec5a4dcf1b66a78ee9c9fa8f3.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 698cd20..59b71be 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.34 2008/09/25 19:51:29 dgp Exp $
+# RCS: @(#) $Id: var.test,v 1.35 2010/02/02 00:11:31 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
@@ -725,9 +725,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
@@ -736,13 +736,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}
@@ -761,3 +781,7 @@ catch {unset aaaaa}
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: