summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2010-01-03 20:29:11 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2010-01-03 20:29:11 (GMT)
commit10428413079058e0f75d48d4f976493454730d0b (patch)
treedce88a02399c32caf6d59948227d30e00d697a4d /tests
parentd20cf874f1303bf21f722abb01c7d1f08a9dc251 (diff)
downloadtcl-10428413079058e0f75d48d4f976493454730d0b.zip
tcl-10428413079058e0f75d48d4f976493454730d0b.tar.gz
tcl-10428413079058e0f75d48d4f976493454730d0b.tar.bz2
* generic/tclBasic.c: Fix lerak of coroutines on namespace
* generic/tclCompile.h: deletion, [Bug 2724403]. Added a test * generic/tclNamesp.c: for this leak, and also a test for * tests/coroutine.test: leaks on namespace deletion. * tests/namespace.test:
Diffstat (limited to 'tests')
-rw-r--r--tests/coroutine.test27
-rw-r--r--tests/namespace.test25
2 files changed, 50 insertions, 2 deletions
diff --git a/tests/coroutine.test b/tests/coroutine.test
index b4019d4..caa1d0a 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: coroutine.test,v 1.10 2009/12/19 14:22:00 msofer Exp $
+# RCS: @(#) $Id: coroutine.test,v 1.11 2010/01/03 20:29:12 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -17,6 +17,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
testConstraint testnrelevels [llength [info commands testnrelevels]]
+testConstraint memory [llength [info commands memory]]
set lambda [list {{start 0} {stop 10}} {
# init
@@ -378,6 +379,7 @@ test coroutine-4.2 {bug #2093188} -setup {
rename bar {}
unset ::res
} -result {{} 3 {{v {} read} {v {} unset}}}
+
test coroutine-4.3 {bug #2093947} -setup {
proc foo {} {
set v 1
@@ -412,6 +414,29 @@ test coroutine-4.4 {bug #2917627: cmd resolution} -setup {
namespace delete b
} -result local
+test coroutine-4.5 {bug #2724403} -constraints {memory} \
+-setup {
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex $lines 3 3
+ }
+} -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ set ns ::y$i
+ namespace eval $ns {}
+ proc ${ns}::start {} {yield; puts hello}
+ coroutine ${ns}::run ${ns}::start
+ namespace delete $ns
+ set start $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $start}]
+} -cleanup {
+ rename getbytes {}
+ unset i ns start end
+} -result 0
+
test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \
-setup {
proc nestedYield {{val {}}} {
diff --git a/tests/namespace.test b/tests/namespace.test
index 5feaf91..889f945 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,13 +11,15 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: namespace.test,v 1.76 2009/01/09 15:00:27 dkf Exp $
+# RCS: @(#) $Id: namespace.test,v 1.77 2010/01/03 20:29:12 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+testConstraint memory [llength [info commands memory]]
+
#
# REMARK: the tests for 'namespace upvar' are not done here. They are to be
# found in the file 'upvar.test'.
@@ -2853,6 +2855,27 @@ test namespace-53.10 {ensembles: nested rewrite} -setup {
1 {wrong # args: should be "ns v x z2 a2"}\
0 {2 v v2}}
+test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
+-setup {
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex $lines 3 3
+ }
+} -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ set ns ::y$i
+ namespace eval $ns {}
+ namespace delete $ns
+ set start $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $start}]
+} -cleanup {
+ rename getbytes {}
+ unset i ns start end
+} -result 0
+
# cleanup
catch {rename cmd1 {}}
catch {unset l}