summaryrefslogtreecommitdiffstats
path: root/tests/trace.test
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2005-11-07 10:17:59 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2005-11-07 10:17:59 (GMT)
commit04667b0794b018d5bb5ed3f702fbb2254b2b73b0 (patch)
tree74cd65a0cf4dce6d465d8c8c4b2184a9c1b86729 /tests/trace.test
parent97e03b3b4d93ec2a39aadc6fa256e55e5c0f6bdc (diff)
downloadtcl-04667b0794b018d5bb5ed3f702fbb2254b2b73b0.zip
tcl-04667b0794b018d5bb5ed3f702fbb2254b2b73b0.tar.gz
tcl-04667b0794b018d5bb5ed3f702fbb2254b2b73b0.tar.bz2
* tests/trace.test (trace-13.2-4): added tests to detect leak, see [Bug
1348775]. The recently added trace-8.9 test is now 13.4.
Diffstat (limited to 'tests/trace.test')
-rw-r--r--tests/trace.test67
1 files changed, 49 insertions, 18 deletions
diff --git a/tests/trace.test b/tests/trace.test
index 86d2b39..befb0c8 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,7 +11,7 @@
# 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.44 2005/11/05 02:10:55 msofer Exp $
+# RCS: @(#) $Id: trace.test,v 1.45 2005/11/07 10:17:59 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -549,22 +549,6 @@ test trace-8.8 {error returns from traces} {
}
unset x
} {}
-test trace-8.9 {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 to see that variables are expunged before trace
# procedures are invoked, so trace procedure can even manipulate
@@ -739,7 +723,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} {
@@ -761,6 +745,53 @@ test trace-13.1 {delete one trace from another} {
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.
# Syntax for adding/removing variable and command traces is basically the