summaryrefslogtreecommitdiffstats
path: root/tests/tailcall.test
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2009-12-05 22:05:30 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2009-12-05 22:05:30 (GMT)
commit7d1b131bf956648e967fd73526440d0741f11533 (patch)
tree039349ef81d3848efadf4f1ad12d72e49fadf956 /tests/tailcall.test
parent90bd6886192a7f8aba161a9c45eb000b9e59e69c (diff)
downloadtcl-7d1b131bf956648e967fd73526440d0741f11533.zip
tcl-7d1b131bf956648e967fd73526440d0741f11533.tar.gz
tcl-7d1b131bf956648e967fd73526440d0741f11533.tar.bz2
* tests/tailcall.test: remove some old unused crud; improved the
stack depth tests.
Diffstat (limited to 'tests/tailcall.test')
-rw-r--r--tests/tailcall.test55
1 files changed, 28 insertions, 27 deletions
diff --git a/tests/tailcall.test b/tests/tailcall.test
index 5918bfe..ff9b97c 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.10 2009/12/05 21:30:06 msofer Exp $
+# RCS: @(#) $Id: tailcall.test,v 1.11 2009/12/05 22:05:30 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -25,7 +25,6 @@ testConstraint testnrelevels [llength [info commands testnrelevels]]
if {[testConstraint testnrelevels]} {
namespace eval testnre {
- namespace path ::tcl::mathop
#
# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
# cmdFrame level, callFrame level, tosPtr and callback depth
@@ -41,23 +40,6 @@ if {[testConstraint testnrelevels]} {
set last $depth
return $res
}
- proc setabs {} {
- variable abs [- [lindex [testnrelevels] 0]]
- }
-
- variable body0 {
- set x [depthDiff]
- if {[incr i] > 10} {
- namespace upvar [namespace qualifiers \
- [namespace origin depthDiff]] abs abs
- incr abs [lindex [testnrelevels] 0]
- return [list [lrange $x 0 3] $abs]
- }
- }
- proc makebody txt {
- variable body0
- return "$body0; $txt"
- }
namespace export *
}
namespace import testnre::*
@@ -65,10 +47,17 @@ if {[testConstraint testnrelevels]} {
test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup {
proc a i {
+ #
+ # NOTE: there may be a diff in callback depth with the first call
+ # ($i==0) due to the fact that the first is from an eval. Successive
+ # calls should add nothing to any stack depths.
+ #
+ if {$i == 1} {
+ depthDiff
+ }
if {[incr i] > 10} {
return [depthDiff]
}
- depthDiff
tailcall a $i
}
} -body {
@@ -79,10 +68,12 @@ test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup
test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup {
set a { i {
+ if {$i == 1} {
+ depthDiff
+ }
if {[incr i] > 10} {
return [depthDiff]
}
- depthDiff
upvar 1 a a
tailcall apply $a $i
}}
@@ -94,10 +85,12 @@ test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup
test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup {
proc a i {
+ if {$i == 1} {
+ depthDiff
+ }
if {[incr i] > 10} {
return [depthDiff]
}
- depthDiff
tailcall b $i
}
interp alias {} b {} a
@@ -113,10 +106,12 @@ test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup
namespace export *
}
proc ::ns::a i {
+ if {$i == 1} {
+ depthDiff
+ }
if {[incr i] > 10} {
return [depthDiff]
}
- depthDiff
set b [uplevel 1 [list namespace which b]]
tailcall $b $i
}
@@ -131,10 +126,12 @@ test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup
test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup {
proc b i {
+ if {$i == 1} {
+ depthDiff
+ }
if {[incr i] > 10} {
return [depthDiff]
}
- depthDiff
tailcall a b $i
}
namespace ensemble create -command a -map {b b}
@@ -150,10 +147,12 @@ test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels known
# This test fails because ns-unknown is not NR-enabled
#
proc c i {
+ if {$i == 1} {
+ depthDiff
+ }
if {[incr i] > 10} {
return [depthDiff]
}
- depthDiff
tailcall a b $i
}
proc d {ens sub args} {
@@ -172,10 +171,12 @@ test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup
catch {rename foo {}}
oo::class create foo {
method b i {
+ if {$i == 1} {
+ depthDiff
+ }
if {[incr i] > 10} {
return [depthDiff]
}
- depthDiff
tailcall [self] b $i
}
}
@@ -562,7 +563,7 @@ test tailcall-12.3b {[Bug 2695587]} -setup {
test tailcall-13.1 {tailcall and coroutine} -setup {
set lambda {i {
- if {$i == 0} {
+ if {$i == 1} {
depthDiff
}
if {[incr i] > 10} {