diff options
| -rw-r--r-- | doc/zipfs.n | 2 | ||||
| -rw-r--r-- | generic/tclBasic.c | 10 | ||||
| -rw-r--r-- | tests/coroutine.test | 17 |
3 files changed, 20 insertions, 9 deletions
diff --git a/doc/zipfs.n b/doc/zipfs.n index f4e2949..2cf00aa 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -131,7 +131,7 @@ The command returns the normalized mount point path. If not under the zipfs file system root, \fImountpoint\fR is normalized with respect to it. For example, a mount point passed as either \fBmt\fR or \fB/mt\fR would be normalized to \fB//zipfs:/mt\fR (given that \fBzipfs root\fR -returns +returns .QW //zipfs:/ ). An error is raised if the mount point includes a drive or UNC volume. .PP diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e76a3b6..c73324d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -252,7 +252,9 @@ static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; +#ifndef TCL_NO_DEPRECATED static Tcl_ObjCmdProc NRInjectObjCmd; +#endif /* TCL_NO_DEPRECATED */ static Tcl_NRPostProc NRPostInvoke; static Tcl_ObjCmdProc CoroTypeObjCmd; static Tcl_ObjCmdProc TclNRCoroInjectObjCmd; @@ -471,7 +473,7 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = { {"process", "status"}, {"process", "purge"}, {"process", "autopurge"}, - /* + /* * [zipfs] perhaps has some safe commands. But like file make it inaccessible * until they are analyzed to be safe. */ @@ -1217,8 +1219,10 @@ Tcl_CreateInterp(void) cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ +#ifndef TCL_NO_DEPRECATED Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); +#endif /* TCL_NO_DEPRECATED */ Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", CoroTypeObjCmd, NULL, NULL); @@ -9892,6 +9896,7 @@ TclNRCoroutineActivateCallback( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED static int TclNREvalList( void *data[], @@ -9909,6 +9914,7 @@ TclNREvalList( TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -10246,6 +10252,7 @@ InjectHandlerPostCall( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED static int NRInjectObjCmd( TCL_UNUSED(void *), @@ -10290,6 +10297,7 @@ NRInjectObjCmd( return TCL_OK; } +#endif /* TCL_NO_DEPRECATED */ int TclNRInterpCoroutine( diff --git a/tests/coroutine.test b/tests/coroutine.test index c3023f7..0d1224c 100644 --- a/tests/coroutine.test +++ b/tests/coroutine.test @@ -17,6 +17,8 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] +source [file join [file dirname [info script]] tcltests.tcl] + testConstraint testnrelevels [llength [info commands testnrelevels]] testConstraint memory [llength [info commands memory]] @@ -826,7 +828,7 @@ test coroutine-7.14 { } -result {failure failure} -test coroutine-8.0.0 {coro inject executed} -body { +test coroutine-8.0.0 {coro inject executed} -constraints deprecated -body { coroutine demo apply {{} { foreach i {1 2} yield }} demo set ::result none @@ -834,7 +836,7 @@ test coroutine-8.0.0 {coro inject executed} -body { demo set ::result } -result {inject-executed} -test coroutine-8.0.1 {coro inject after error} -body { +test coroutine-8.0.1 {coro inject after error} -constraints deprecated -body { coroutine demo apply {{} { foreach i {1 2} yield; error test }} demo set ::result none @@ -846,7 +848,7 @@ test coroutine-8.1.1 {coro inject, ticket 42202ba1e5ff566e} -body { child eval { coroutine demo apply {{} { while {1} yield }} demo - tcl::unsupported::inject demo set ::result inject-executed + coroinject demo set ::result inject-executed } interp delete child } -result {} @@ -855,14 +857,15 @@ test coroutine-8.1.2 {coro inject with result, ticket 42202ba1e5ff566e} -body { child eval { coroutine demo apply {{} { while {1} yield }} demo - tcl::unsupported::inject demo set ::result inject-executed + coroinject demo lappend ::result inject-executed } child eval demo set result [child eval {set ::result}] interp delete child set result -} -result {inject-executed} +} -result {inject-executed yield {}} + test coroutine-9.1 {coroprobe with yield} -body { coroutine demo apply {{} { foreach i {1 2} yield }} @@ -1037,7 +1040,7 @@ test coroutine-12.1 {coroutine general introspection} -setup { $i eval { # Make the introspection code namespace path tcl::unsupported - proc probe {type var} { + proc probe {var type args} { upvar 1 $var v set f [info frame] incr f -1 @@ -1049,7 +1052,7 @@ test coroutine-12.1 {coroutine general introspection} -setup { } } proc pokecoro {c var} { - inject $c probe [corotype $c] $var + coroinject $c probe $var $c } |