summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclBasic.c37
-rw-r--r--generic/tclCmdIL.c3
-rw-r--r--generic/tclInt.h4
-rw-r--r--tests/info.test10
-rw-r--r--tests/unsupported.test128
6 files changed, 74 insertions, 115 deletions
diff --git a/ChangeLog b/ChangeLog
index aab2654..3fe1549 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2008-10-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Move [tailcall], [coroutine] and
+ * generic/tclCmdIL.c: [yield] out of ::tcl::unsupported
+ * tests/info.test: and into global scope: TIPs #327
+ * tests/unsupported.test: and #328
+
2008-10-07 Donal K. Fellows <dkf@users.sf.net>
* doc/chan.n, doc/transchan.n: Documented the channel transformation
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 036707d..afddfb6 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.370 2008/10/03 00:01:35 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.371 2008/10/07 17:57:42 msofer Exp $
*/
#include "tclInt.h"
@@ -139,9 +139,6 @@ static Tcl_NRPostProc NRRunObjProc;
static Tcl_NRPostProc AtProcExitCleanup;
static Tcl_NRPostProc NRAtProcExitEval;
-static int InfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-
/*
* The following structure define the commands in the Tcl core.
*/
@@ -216,7 +213,10 @@ static const CmdInfo builtInCmds[] = {
{"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, 1},
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, 1},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, 1},
-
+
+ {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, 1},
+ {"yield", NULL, NULL, TclNRYieldObjCmd, 1},
+
/*
* Commands in the OS-interface. Note that many of these are unsafe.
*/
@@ -712,7 +712,8 @@ Tcl_CreateInterp(void)
for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
if ((cmdInfoPtr->objProc == NULL)
- && (cmdInfoPtr->compileProc == NULL)) {
+ && (cmdInfoPtr->compileProc == NULL)
+ && (cmdInfoPtr->nreProc == NULL)) {
Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
}
@@ -780,23 +781,16 @@ Tcl_CreateInterp(void)
Tcl_DisassembleObjCmd, NULL, NULL);
/*
- * Create unsupported commands for tailcall, coroutine and yield
- * Create unsupported commands for atProcExit and tailcall
+ * Create the 'tailcall' command an unsupported command for 'atProcExit'
*/
- Tcl_NRCreateCommand(interp, "::tcl::unsupported::atProcExit",
- /*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_ATEXIT_TYPE),
- NULL);
- Tcl_NRCreateCommand(interp, "::tcl::unsupported::tailcall",
+ Tcl_NRCreateCommand(interp, "tailcall",
/*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_TAILCALL_TYPE),
NULL);
- Tcl_NRCreateCommand(interp, "::tcl::unsupported::coroutine",
- /*objProc*/ NULL, TclNRCoroutineObjCmd, NULL, NULL);
- Tcl_NRCreateCommand(interp, "::tcl::unsupported::yield",
- /*objProc*/ NULL, TclNRYieldObjCmd, NULL, NULL);
- Tcl_NRCreateCommand(interp, "::tcl::unsupported::infoCoroutine",
- /*objProc*/ NULL, InfoCoroutineCmd, NULL, NULL);
+ Tcl_NRCreateCommand(interp, "::tcl::unsupported::atProcExit",
+ /*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_ATEXIT_TYPE),
+ NULL);
#ifdef USE_DTRACE
/*
@@ -5626,7 +5620,6 @@ Tcl_EvalObj(
{
return Tcl_EvalObjEx(interp, objPtr, 0);
}
-
#undef Tcl_GlobalEvalObj
int
Tcl_GlobalEvalObj(
@@ -8490,11 +8483,11 @@ TclNRCoroutineObjCmd(
}
/*
- * This belongs in the [info] ensemble later on
+ * This is used in the [info] ensemble
*/
-static int
-InfoCoroutineCmd(
+int
+TclInfoCoroutineCmd(
ClientData dummy,
Tcl_Interp *interp,
int objc,
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index cffc0dd..471560d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.159 2008/10/04 18:06:48 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.160 2008/10/07 17:57:43 msofer Exp $
*/
#include "tclInt.h"
@@ -160,6 +160,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
{"cmdcount", InfoCmdCountCmd, NULL},
{"commands", InfoCommandsCmd, NULL},
{"complete", InfoCompleteCmd, NULL},
+ {"coroutine", TclInfoCoroutineCmd, NULL},
{"default", InfoDefaultCmd, NULL},
{"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd},
{"frame", InfoFrameCmd, NULL},
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4704927..d33dd1d 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.401 2008/10/03 00:01:35 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.402 2008/10/07 17:57:43 msofer Exp $
*/
#ifndef _TCLINT
@@ -2663,6 +2663,8 @@ MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
diff --git a/tests/info.test b/tests/info.test
index 9f94dd3..1078536 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: info.test,v 1.60 2008/10/02 23:20:30 andreas_kupries Exp $
+# RCS: @(#) $Id: info.test,v 1.61 2008/10/07 17:57:43 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -675,16 +675,16 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
info gorp
-} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
info c
-} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
info l
-} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
info s
-} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
##
# ### ### ### ######### ######### #########
diff --git a/tests/unsupported.test b/tests/unsupported.test
index 553021b..c41d4bc 100644
--- a/tests/unsupported.test
+++ b/tests/unsupported.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: unsupported.test,v 1.11 2008/09/28 13:46:12 msofer Exp $
+# RCS: @(#) $Id: unsupported.test,v 1.12 2008/10/07 17:57:43 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -18,8 +18,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
testConstraint testnrelevels [llength [info commands testnrelevels]]
testConstraint atProcExit [llength [info commands ::tcl::unsupported::atProcExit]]
-testConstraint tailcall [llength [info commands ::tcl::unsupported::tailcall]]
-testConstraint coroutine [llength [info commands ::tcl::unsupported::yield]]
if {[namespace exists tcl::unsupported]} {
namespace eval tcl::unsupported namespace export *
@@ -213,7 +211,7 @@ test unsupported-A9 {atProcExit and uplevel} -constraints {knownBug atProcExit}
# Test tailcalls
#
-test unsupported-T.0 {tailcall is constant space} -constraints {tailcall} -setup {
+test unsupported-T.0 {tailcall is constant space} -setup {
proc a i {
if {[incr i] > 10} {
return [depthDiff]
@@ -227,7 +225,7 @@ test unsupported-T.0 {tailcall is constant space} -constraints {tailcall} -setup
rename a {}
} -result {0 0 0 0 0 0}
-test unsupported-T.1 {tailcall} -constraints {tailcall} -body {
+test unsupported-T.1 {tailcall} -body {
namespace eval a {
variable x *::a
proc xset {} {
@@ -257,11 +255,11 @@ test unsupported-T.1 {tailcall} -constraints {tailcall} -body {
} -result {1::b | 0:: *::a *::b | {{1 ::b::moo} {2 xset}}}
-test unsupported-T.2 {tailcall in non-proc} -constraints {tailcall} -body {
+test unsupported-T.2 {tailcall in non-proc} -body {
namespace eval a [list tailcall set x 1]
} -match glob -result *tailcall* -returnCodes error
-test unsupported-T.3 {tailcall falls off tebc} -constraints {tailcall} -body {
+test unsupported-T.3 {tailcall falls off tebc} -body {
unset -nocomplain x
proc foo {} {tailcall set x 1}
list [catch foo msg] $msg [set x]
@@ -270,7 +268,7 @@ test unsupported-T.3 {tailcall falls off tebc} -constraints {tailcall} -body {
unset x
} -result {0 1 1}
-test unsupported-T.4 {tailcall falls off tebc} -constraints {tailcall} -body {
+test unsupported-T.4 {tailcall falls off tebc} -body {
set x 2
proc foo {} {tailcall set x 1}
foo
@@ -280,7 +278,7 @@ test unsupported-T.4 {tailcall falls off tebc} -constraints {tailcall} -body {
unset x
} -result 1
-test unsupported-T.5 {tailcall falls off tebc} -constraints {tailcall} -body {
+test unsupported-T.5 {tailcall falls off tebc} -body {
set x 2
namespace eval bar {
variable x 3
@@ -293,7 +291,7 @@ test unsupported-T.5 {tailcall falls off tebc} -constraints {tailcall} -body {
namespace delete bar
} -result {1 3}
-test unsupported-T.6 {tailcall does remove callframes} -constraints {tailcall} -body {
+test unsupported-T.6 {tailcall does remove callframes} -body {
proc foo {} {info level}
proc moo {} {tailcall foo}
proc boo {} {expr {[moo] - [info level]}}
@@ -304,7 +302,7 @@ test unsupported-T.6 {tailcall does remove callframes} -constraints {tailcall} -
rename boo {}
} -result 1
-test unsupported-T.7 {tailcall does return} -constraints {tailcall} -setup {
+test unsupported-T.7 {tailcall does return} -setup {
namespace eval ::foo {
variable res {}
proc a {} {
@@ -332,7 +330,7 @@ test unsupported-T.7 {tailcall does return} -constraints {tailcall} -setup {
namespace delete ::foo
} -result cbabc
-test unsupported-T.8 {tailcall tailcall} -constraints {tailcall} -setup {
+test unsupported-T.8 {tailcall tailcall} -setup {
namespace eval ::foo {
variable res {}
proc a {} {
@@ -360,7 +358,7 @@ test unsupported-T.8 {tailcall tailcall} -constraints {tailcall} -setup {
namespace delete ::foo
} -match glob -result *tailcall* -returnCodes error
-test unsupported-T.9 {tailcall factorial} -constraints {tailcall} -setup {
+test unsupported-T.9 {tailcall factorial} -setup {
proc fact {n {b 1}} {
if {$n == 1} {
return $b
@@ -400,7 +398,7 @@ test unsupported-T.11 {tailcall and uplevel} -constraints {knownBug atProcExit}
#
test unsupported-AT.1 {atProcExit and tailcall} -constraints {
- atProcExit tailcall
+ atProcExit
} -setup {
variable x x y y
proc a {} {
@@ -424,11 +422,6 @@ test unsupported-AT.1 {atProcExit and tailcall} -constraints {
# Test coroutines
#
-if {[testConstraint coroutine]} {
- namespace import tcl::unsupported::coroutine
- namespace import tcl::unsupported::yield
-}
-
set lambda [list {{start 0} {stop 10}} {
# init
set i $start
@@ -442,8 +435,7 @@ set lambda [list {{start 0} {stop 10}} {
}]
-test unsupported-C.1.1 {coroutine basic} -constraints {coroutine} \
--setup {
+test unsupported-C.1.1 {coroutine basic} -setup {
coroutine foo ::apply $lambda
set res {}
} -body {
@@ -456,8 +448,7 @@ test unsupported-C.1.1 {coroutine basic} -constraints {coroutine} \
unset res
} -result {0 10 20}
-test unsupported-C.1.2 {coroutine basic} -constraints {coroutine} \
--setup {
+test unsupported-C.1.2 {coroutine basic} -setup {
coroutine foo ::apply $lambda 2 8
set res {}
} -body {
@@ -470,8 +461,7 @@ test unsupported-C.1.2 {coroutine basic} -constraints {coroutine} \
unset res
} -result {16 24 32}
-test unsupported-C.1.3 {yield returns new arg} -constraints {coroutine} \
--setup {
+test unsupported-C.1.3 {yield returns new arg} -setup {
set body {
# init
set i $start
@@ -495,8 +485,7 @@ test unsupported-C.1.3 {yield returns new arg} -constraints {coroutine} \
unset res
} -result {20 6 12}
-test unsupported-C.1.4 {yield in nested proc} -constraints {coroutine} \
--setup {
+test unsupported-C.1.4 {yield in nested proc} -setup {
proc moo {} {
upvar 1 i i stop stop
yield [expr {$i*$stop}]
@@ -525,24 +514,21 @@ test unsupported-C.1.4 {yield in nested proc} -constraints {coroutine} \
unset body res
} -result {0 10 20}
-test unsupported-C.1.5 {just yield} -constraints {coroutine} \
--body {
+test unsupported-C.1.5 {just yield} -body {
coroutine foo yield
list [foo] [catch foo msg] $msg
} -cleanup {
unset msg
} -result {{} 1 {invalid command name "foo"}}
-test unsupported-C.1.6 {just yield} -constraints {coroutine} \
--body {
+test unsupported-C.1.6 {just yield} -body {
coroutine foo [list yield]
list [foo] [catch foo msg] $msg
} -cleanup {
unset msg
} -result {{} 1 {invalid command name "foo"}}
-test unsupported-C.1.7 {yield in nested uplevel} -constraints {coroutine} \
--setup {
+test unsupported-C.1.7 {yield in nested uplevel} -setup {
set body {
# init
set i $start
@@ -566,8 +552,7 @@ test unsupported-C.1.7 {yield in nested uplevel} -constraints {coroutine} \
unset body res
} -result {0 10 20}
-test unsupported-C.1.8 {yield in nested uplevel} -constraints {coroutine} \
--setup {
+test unsupported-C.1.8 {yield in nested uplevel} -setup {
set body {
# init
set i $start
@@ -591,8 +576,7 @@ test unsupported-C.1.8 {yield in nested uplevel} -constraints {coroutine} \
unset body res
} -result {0 10 20}
-test unsupported-C.1.9 {yield in nested eval} -constraints {coroutine} \
--setup {
+test unsupported-C.1.9 {yield in nested eval} -setup {
proc moo {} {
upvar 1 i i stop stop
yield [expr {$i*$stop}]
@@ -620,8 +604,7 @@ test unsupported-C.1.9 {yield in nested eval} -constraints {coroutine} \
unset body res
} -result {0 10 20}
-test unsupported-C.1.10 {yield in nested eval} -constraints {coroutine} \
--setup {
+test unsupported-C.1.10 {yield in nested eval} -setup {
set body {
# init
set i $start
@@ -644,8 +627,7 @@ test unsupported-C.1.10 {yield in nested eval} -constraints {coroutine} \
unset body res
} -result {0 10 20}
-test unsupported-C.1.11 {yield outside coroutine} -constraints {coroutine} \
--setup {
+test unsupported-C.1.11 {yield outside coroutine} -setup {
proc moo {} {
upvar 1 i i stop stop
yield [expr {$i*$stop}]
@@ -658,8 +640,7 @@ test unsupported-C.1.11 {yield outside coroutine} -constraints {coroutine} \
unset i stop
} -returnCodes error -result {yield can only be called in a coroutine}
-test unsupported-C.1.12 {proc as coroutine} -constraints {coroutine} \
--setup {
+test unsupported-C.1.12 {proc as coroutine} -setup {
set body {
# init
set i $start
@@ -681,44 +662,37 @@ test unsupported-C.1.12 {proc as coroutine} -constraints {coroutine} \
rename foo {}
} -result {16 24}
-test unsupported-C.2.1 {self deletion on return} -constraints {coroutine} \
--body {
+test unsupported-C.2.1 {self deletion on return} -body {
coroutine foo set x 3
foo
} -returnCodes error -result {invalid command name "foo"}
-test unsupported-C.2.2 {self deletion on return} -constraints {coroutine} \
--body {
+test unsupported-C.2.2 {self deletion on return} -body {
coroutine foo ::apply [list {} {yield; yield 1; return 2}]
list [foo] [foo] [catch foo msg] $msg
} -result {1 2 1 {invalid command name "foo"}}
-test unsupported-C.2.3 {self deletion on error return} -constraints {coroutine} \
--body {
+test unsupported-C.2.3 {self deletion on error return} -body {
coroutine foo ::apply [list {} {yield;yield 1; error ouch!}]
list [foo] [catch foo msg] $msg [catch foo msg] $msg
} -result {1 1 ouch! 1 {invalid command name "foo"}}
-test unsupported-C.2.4 {self deletion on other return} -constraints {coroutine} \
--body {
+test unsupported-C.2.4 {self deletion on other return} -body {
coroutine foo ::apply [list {} {yield;yield 1; return -code 100 ouch!}]
list [foo] [catch foo msg] $msg [catch foo msg] $msg
} -result {1 100 ouch! 1 {invalid command name "foo"}}
-test unsupported-C.2.5 {deletion of suspended coroutine} -constraints {coroutine} \
--body {
+test unsupported-C.2.5 {deletion of suspended coroutine} -body {
coroutine foo ::apply [list {} {yield; yield 1; return 2}]
list [foo] [rename foo {}] [catch foo msg] $msg
} -result {1 {} 1 {invalid command name "foo"}}
-test unsupported-C.2.6 {deletion of running coroutine} -constraints {coroutine} \
--body {
+test unsupported-C.2.6 {deletion of running coroutine} -body {
coroutine foo ::apply [list {} {yield; rename foo {}; yield 1; return 2}]
list [foo] [catch foo msg] $msg
} -result {1 1 {invalid command name "foo"}}
-test unsupported-C.3.1 {info level computation} -constraints {coroutine} \
--setup {
+test unsupported-C.3.1 {info level computation} -setup {
proc a {} {while 1 {yield [info level]}}
proc b {} foo
} -body {
@@ -732,8 +706,7 @@ test unsupported-C.3.1 {info level computation} -constraints {coroutine} \
rename b {}
} -result {1 1 1}
-test unsupported-C.3.2 {info frame computation} -constraints {coroutine} \
--setup {
+test unsupported-C.3.2 {info frame computation} -setup {
proc a {} {while 1 {yield [info frame]}}
proc b {} foo
} -body {
@@ -746,9 +719,8 @@ test unsupported-C.3.2 {info frame computation} -constraints {coroutine} \
rename b {}
} -result 1
-test unsupported-C.3.3 {info coroutine} -constraints {coroutine} \
--setup {
- proc a {} {infoCoroutine}
+test unsupported-C.3.3 {info coroutine} -setup {
+ proc a {} {info coroutine}
proc b {} a
} -body {
b
@@ -757,9 +729,8 @@ test unsupported-C.3.3 {info coroutine} -constraints {coroutine} \
rename b {}
} -result {}
-test unsupported-C.3.4 {info coroutine} -constraints {coroutine} \
--setup {
- proc a {} {infoCoroutine}
+test unsupported-C.3.4 {info coroutine} -setup {
+ proc a {} {info coroutine}
proc b {} a
} -body {
coroutine foo b
@@ -769,8 +740,7 @@ test unsupported-C.3.4 {info coroutine} -constraints {coroutine} \
} -result ::foo
-test unsupported-C.4.1 {bug #2093188} -constraints {coroutine} \
--setup {
+test unsupported-C.4.1 {bug #2093188} -setup {
proc foo {} {
set v 1
trace add variable v {write unset} bar
@@ -789,8 +759,7 @@ test unsupported-C.4.1 {bug #2093188} -constraints {coroutine} \
unset ::res
} -result {{} 3 {{v {} write} {v {} write} {v {} unset}}}
-test unsupported-C.4.2 {bug #2093188} -constraints {coroutine} \
--setup {
+test unsupported-C.4.2 {bug #2093188} -setup {
proc foo {} {
set v 1
trace add variable v {read unset} bar
@@ -810,8 +779,7 @@ test unsupported-C.4.2 {bug #2093188} -constraints {coroutine} \
unset ::res
} -result {{} 3 {{v {} read} {v {} unset}}}
-test unsupported-C.4.2 {bug #2093947} -constraints {coroutine} \
--setup {
+test unsupported-C.4.2 {bug #2093947} -setup {
proc foo {} {
set v 1
trace add variable v {write unset} bar
@@ -835,7 +803,7 @@ test unsupported-C.4.2 {bug #2093947} -constraints {coroutine} \
unset ::res
} -result {{v {} write} {v {} write} {v {} unset} {v {} write} {v {} unset}}
-test unsupported-C.5.1 {right numLevels on coro return} -constraints {coroutine testnrelevels} \
+test unsupported-C.5.1 {right numLevels on coro return} -constraints {testnrelevels} \
-setup {
proc nestedYield {{val {}}} {
yield $val
@@ -878,7 +846,7 @@ test unsupported-C.5.1 {right numLevels on coro return} -constraints {coroutine
unset res
} -result {0 0 0 0 0 0}
-test unsupported-C.5.2 {right numLevels within coro} -constraints {coroutine testnrelevels} \
+test unsupported-C.5.2 {right numLevels within coro} -constraints {testnrelevels} \
-setup {
proc nestedYield {{val {}}} {
yield $val
@@ -904,9 +872,6 @@ test unsupported-C.5.2 {right numLevels within coro} -constraints {coroutine tes
lappend res [eval {eval {a [getNumLevel]}}]
set base [lindex $res 0]
foreach x $res[set res {}] {
- # REMARK: the first call is one level deeper due to [coroutine] being
- # on the Tcl call stack: the proper result is a leading 0 and a
- # sequence of -1s
lappend res [expr {$x-$base}]
}
set res
@@ -917,7 +882,7 @@ test unsupported-C.5.2 {right numLevels within coro} -constraints {coroutine tes
rename getNumLevel {}
rename relativeLevel {}
unset res
-} -result {0 -1 -1 -1}
+} -result {0 0 0 0}
@@ -927,19 +892,10 @@ test unsupported-C.5.2 {right numLevels within coro} -constraints {coroutine tes
unset -nocomplain lambda
-if {[testConstraint tailcall]} {
- namespace forget tcl::unsupported::tailcall
-}
-
if {[testConstraint atProcExit]} {
namespace forget tcl::unsupported::atProcExit
}
-if {[testConstraint coroutine]} {
- namespace forget tcl::unsupported::coroutine
- namespace forget tcl::unsupported::yield
-}
-
if {[testConstraint testnrelevels]} {
namespace forget testnre::*
namespace delete testnre