summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2005-11-07 10:28:01 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2005-11-07 10:28:01 (GMT)
commite2f09c4107bf748b1afc2f40e341fa7cb19feb4d (patch)
treefe9c3bf3515c7d1cdc42cf51bac8e97ff29d7fce /tests
parentee791e433719e8e012bc9eaee159cf37384203cb (diff)
downloadtcl-e2f09c4107bf748b1afc2f40e341fa7cb19feb4d.zip
tcl-e2f09c4107bf748b1afc2f40e341fa7cb19feb4d.tar.gz
tcl-e2f09c4107bf748b1afc2f40e341fa7cb19feb4d.tar.bz2
* tests/trace.test (trace-13.2-4): added tests to detect leak, see [Bug
1348775].
Diffstat (limited to 'tests')
-rw-r--r--tests/trace.test58
1 files changed, 56 insertions, 2 deletions
diff --git a/tests/trace.test b/tests/trace.test
index 9569ae0..4eba508 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,13 +11,21 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: trace.test,v 1.26.2.11 2005/11/04 01:15:21 msofer Exp $
+# RCS: @(#) $Id: trace.test,v 1.26.2.12 2005/11/07 10:28:01 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+
+proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex [lindex $lines 3] 3
+}
+
proc traceScalar {name1 name2 op} {
global info
set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
@@ -713,7 +721,7 @@ test trace-12.8 {errors when setting variable traces} {
list [catch {trace add variable x(0) write traceProc} msg] $msg
} {1 {can't trace "x(0)": variable isn't array}}
-# Check deleting one trace from another.
+# Check trace deletion
test trace-13.1 {delete one trace from another} {
proc delTraces {args} {
@@ -734,6 +742,52 @@ test trace-13.1 {delete one trace from another} {
set x
set info
} {5 1}
+test trace-13.2 {leak when unsetting traced variable} \
+ -constraints memory -body {
+ set end [getbytes]
+ proc f args {}
+ for {set i 0} {$i < 5} {incr i} {
+ trace add variable bepa write f
+ set bepa a
+ unset bepa
+ set tmp $end
+ set end [getbytes]
+ }
+ expr {$end - $tmp}
+ } -cleanup {
+ unset -nocomplain end i tmp
+ } -result 0
+test trace-13.3 {leak when removing traces} \
+ -constraints memory -body {
+ set end [getbytes]
+ proc f args {}
+ for {set i 0} {$i < 5} {incr i} {
+ trace add variable bepa write f
+ set bepa a
+ trace remove variable bepa write f
+ set tmp $end
+ set end [getbytes]
+ }
+ expr {$end - $tmp}
+ } -cleanup {
+ unset -nocomplain end i tmp
+ } -result 0
+test trace-13.4 {leaks in error returns from traces} \
+ -constraints memory -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {set bepa a}
+ unset bepa
+ set tmp $end
+ set end [getbytes]
+ }
+ expr {$end - $tmp}
+ } -cleanup {
+ unset -nocomplain end i tmp
+ } -result 0
# Check operation and syntax of "trace" command.