diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclBasic.c | 37 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 3 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | tests/info.test | 10 | ||||
| -rw-r--r-- | tests/unsupported.test | 128 |
6 files changed, 74 insertions, 115 deletions
@@ -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 |