diff options
Diffstat (limited to 'tests/tailcall.test')
| -rw-r--r-- | tests/tailcall.test | 66 |
1 files changed, 28 insertions, 38 deletions
diff --git a/tests/tailcall.test b/tests/tailcall.test index 2d04f82..d6b0214 100644 --- a/tests/tailcall.test +++ b/tests/tailcall.test @@ -27,13 +27,17 @@ testConstraint testnrelevels [llength [info commands testnrelevels]] if {[testConstraint testnrelevels]} { namespace eval testnre { # - # [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels, - # cmdFrame level, callFrame level, tosPtr and callback depth + # [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels, + # callFrame level, tosPtr and callback depth # - variable last [testnrelevels] + proc depthDiff {} { variable last set depth [testnrelevels] + if {![info exists last]} { + set last $depth + return $last + } set res {} foreach t $depth l $last { lappend res [expr {$t-$l}] @@ -57,11 +61,9 @@ test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup # ($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 - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall a $i } @@ -69,15 +71,13 @@ test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup a 0 } -cleanup { rename a {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup { set a { i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } upvar 1 a a tailcall apply $a $i @@ -86,15 +86,13 @@ test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup apply $a 0 } -cleanup { unset a -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup { proc a i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall b $i } @@ -104,18 +102,16 @@ test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup } -cleanup { rename a {} rename b {} -} -result {0 0 0 0 0 0} +} -result {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 {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } set b [uplevel 1 [list namespace which b]] tailcall $b $i @@ -127,15 +123,13 @@ test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup } -cleanup { rename b {} namespace delete ::ns -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup { proc b i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall a b $i } @@ -145,18 +139,16 @@ test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup } -cleanup { rename a {} rename b {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup { # # This test fails because ns-unknown is not NR-enabled # proc c i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall a b $i } @@ -170,17 +162,15 @@ test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels known rename a {} rename c {} rename d {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} 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 - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall [self] b $i } @@ -191,7 +181,7 @@ test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup } -cleanup { rename a {} rename foo {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-1 {tailcall} -body { namespace eval a { |