From 04667b0794b018d5bb5ed3f702fbb2254b2b73b0 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Mon, 7 Nov 2005 10:17:59 +0000
Subject: 	* 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.

---
 ChangeLog        |  5 +++++
 tests/trace.test | 67 +++++++++++++++++++++++++++++++++++++++++---------------
 2 files changed, 54 insertions(+), 18 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index eccea37..2da6b1f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
-- 
cgit v0.12