diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | tests/trace.test | 67 |
2 files changed, 54 insertions, 18 deletions
@@ -1,3 +1,8 @@ +2005-11-07 Miguel Sofer <msofer@users.sf.net> + + * 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. + 2005-11-07 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> * tests/dict.test (dict-19.2): arrange for the stress testing code to 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 |