summaryrefslogtreecommitdiffstats
path: root/tests/tailcall.test
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2009-03-21 11:46:09 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2009-03-21 11:46:09 (GMT)
commit260a0df5b742697276b762bcddd34c141aed9942 (patch)
tree0c34ebae61b4f51a200c06d73f1482a622601bae /tests/tailcall.test
parent61e311e5b2192389f6791a15f4d1227769b95772 (diff)
downloadtcl-260a0df5b742697276b762bcddd34c141aed9942.zip
tcl-260a0df5b742697276b762bcddd34c141aed9942.tar.gz
tcl-260a0df5b742697276b762bcddd34c141aed9942.tar.bz2
* tclInt.h: comments
* tests/tailcall.test: added tests to show that [tailcall] does not currently always execute in constant space: interp-alias, ns-imports and ensembles "leak" as of this commit.
Diffstat (limited to 'tests/tailcall.test')
-rw-r--r--tests/tailcall.test90
1 files changed, 88 insertions, 2 deletions
diff --git a/tests/tailcall.test b/tests/tailcall.test
index 4cfbebf..f67a5e9 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.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: tailcall.test,v 1.4 2009/03/21 09:42:07 msofer Exp $
+# RCS: @(#) $Id: tailcall.test,v 1.5 2009/03/21 11:46:10 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -61,7 +61,7 @@ if {[testConstraint testnrelevels]} {
namespace import testnre::*
}
-test tailcall-0 {tailcall is constant space} -constraints testnrelevels -setup {
+test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup {
proc a i {
if {[incr i] > 10} {
return [depthDiff]
@@ -75,6 +75,92 @@ test tailcall-0 {tailcall is constant space} -constraints testnrelevels -setup {
rename a {}
} -result {0 0 0 0 0 0}
+test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup {
+ set a { i {
+ if {[incr i] > 10} {
+ return [depthDiff]
+ }
+ depthDiff
+ upvar 1 a a
+ tailcall apply $a $i
+ }}
+} -body {
+ apply $a 0
+} -cleanup {
+ unset a
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup {
+ proc a i {
+ if {[incr i] > 10} {
+ return [depthDiff]
+ }
+ depthDiff
+ tailcall b $i
+ }
+ interp alias {} b {} a
+} -body {
+ b 0
+} -cleanup {
+ rename a {}
+ rename b {}
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup {
+ namespace eval ::ns {
+ namespace export *
+ }
+ proc ::ns::a i {
+ if {[incr i] > 10} {
+ return [depthDiff]
+ }
+ depthDiff
+ set b [uplevel 1 [list namespace which b]]
+ tailcall $b $i
+ }
+ namespace import ::ns::a
+ rename a b
+} -body {
+ b 0
+} -cleanup {
+ rename b {}
+ namespace delete ::ns
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup {
+ proc b i {
+ if {[incr i] > 10} {
+ return [depthDiff]
+ }
+ depthDiff
+ tailcall a b $i
+ }
+ namespace ensemble create -command a -map {b b}
+} -body {
+ a b 0
+} -cleanup {
+ rename a {}
+ rename b {}
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.6 {tailcall is constant space} -constraints testnrelevels -setup {
+ oo::class create foo {
+ method b i {
+ if {[incr i] > 10} {
+ return [depthDiff]
+ }
+ depthDiff
+ tailcall [self] b $i
+ }
+ }
+} -body {
+ foo create a
+ a b 0
+} -cleanup {
+ rename a {}
+ rename foo {}
+} -result {0 0 0 0 0 0}
+
test tailcall-1 {tailcall} -body {
namespace eval a {
variable x *::a