diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2009-03-21 11:46:09 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2009-03-21 11:46:09 (GMT) |
commit | 260a0df5b742697276b762bcddd34c141aed9942 (patch) | |
tree | 0c34ebae61b4f51a200c06d73f1482a622601bae | |
parent | 61e311e5b2192389f6791a15f4d1227769b95772 (diff) | |
download | tcl-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.
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | generic/tclInt.h | 6 | ||||
-rw-r--r-- | tests/tailcall.test | 90 |
3 files changed, 96 insertions, 6 deletions
@@ -1,5 +1,11 @@ 2009-03-21 Miguel Sofer <msofer@users.sf.net> + * 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. + * tests/nre.test: [foreach] has been NR-enabled for a while, the test was marked 'knownBug': unmark it. diff --git a/generic/tclInt.h b/generic/tclInt.h index 3c45cc1..5c9e127 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.420 2009/03/21 09:42:07 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.421 2009/03/21 11:46:10 msofer Exp $ */ #ifndef _TCLINT @@ -1059,9 +1059,7 @@ typedef struct CallFrame { struct TEOV_callback *tailcallPtr; /* The callback implementing the call to be * executed by the command that pushed this - * frame. It can be TAILCALL_NONE to signal - * that we are tailcalling a frame further up - * the stack. + * frame. */ } CallFrame; 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 |