summaryrefslogtreecommitdiffstats
path: root/tests/tailcall.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/tailcall.test')
-rw-r--r--tests/tailcall.test63
1 files changed, 42 insertions, 21 deletions
diff --git a/tests/tailcall.test b/tests/tailcall.test
index ff9b97c..b8a3210 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.11 2009/12/05 22:05:30 msofer Exp $
+# RCS: @(#) $Id: tailcall.test,v 1.12 2010/01/22 10:22:51 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -45,6 +45,10 @@ if {[testConstraint testnrelevels]} {
namespace import testnre::*
}
+proc errorcode options {
+ dict get [dict merge {-errorcode NONE} $options] -errorcode
+}
+
test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup {
proc a i {
#
@@ -541,25 +545,17 @@ test tailcall-12.2 {[Bug 2649975]} -setup {
1: exiting from foo's alpha
}
-test tailcall-12.3a {[Bug 2695587]} -setup {
- proc a {} {
- list [catch [list tailcall foo] msg] $msg
- }
-} -body {
- a
-} -cleanup {
- rename a {}
-} -result {1 {Tailcall called from within a catch environment}}
+test tailcall-12.3a {[Bug 2695587]} {
+ apply {{} {
+ list [catch [list tailcall foo] msg opt] $msg [errorcode $opt]
+ }}
+} {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
-test tailcall-12.3b {[Bug 2695587]} -setup {
- proc a {} {
- list [catch {tailcall foo} msg] $msg
- }
-} -body {
- a
-} -cleanup {
- rename a {}
-} -result {1 {Tailcall called from within a catch environment}}
+test tailcall-12.3b {[Bug 2695587]} {
+ apply {{} {
+ list [catch {tailcall foo} msg opt] $msg [errorcode $opt]
+ }}
+} {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
test tailcall-13.1 {tailcall and coroutine} -setup {
set lambda {i {
@@ -576,9 +572,30 @@ test tailcall-13.1 {tailcall and coroutine} -setup {
} -cleanup {
unset lambda
} -result {0 0 0 0 0 0}
-
-
+test tailcall-14.1 {directly tailcalling the tailcall command is an error} {
+ list [catch {
+ apply {{} {
+ apply {{} {
+ tailcall tailcall subst a
+ subst b
+ }}
+ subst c
+ }}
+ } msg opt] $msg [errorcode $opt]
+} {1 {tailcall cannot be invoked recursively} {TCL TAILCALL REENTRY}}
+test tailcall-14.2 {indirectly tailcalling the tailcall command is ok} {
+ list [catch {
+ apply {{} {
+ apply {{} {
+ tailcall eval tailcall subst ok
+ subst b
+ }}
+ subst c
+ }}
+ } msg opt] $msg [errorcode $opt]
+} {0 ok NONE}
+
if {[testConstraint testnrelevels]} {
namespace forget testnre::*
namespace delete testnre
@@ -586,3 +603,7 @@ if {[testConstraint testnrelevels]} {
# cleanup
::tcltest::cleanupTests
+
+# Local Variables:
+# mode: tcl
+# End: