summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2017-04-12 12:33:07 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2017-04-12 12:33:07 (GMT)
commite006ff39be1b45b0cd57c5b2e943e487dde786dd (patch)
treee25debcc2d99c05535e42ff3ed98bd74b15e4fec
parent9b4213bb3f91778b852b5b3bf24904dfb7e6b04b (diff)
parent9faad3da69bd700e51e75388518f53efd46cb32c (diff)
downloadtcl-e006ff39be1b45b0cd57c5b2e943e487dde786dd.zip
tcl-e006ff39be1b45b0cd57c5b2e943e487dde786dd.tar.gz
tcl-e006ff39be1b45b0cd57c5b2e943e487dde786dd.tar.bz2
merge core-8-6-branch
-rw-r--r--generic/tclBasic.c32
-rw-r--r--[-rwxr-xr-x]library/clock.tcl0
-rw-r--r--tests/coroutine.test39
-rw-r--r--[-rwxr-xr-x]win/tclWinFile.c0
4 files changed, 70 insertions, 1 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index aae7ab6..c6784a0 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -8770,6 +8770,35 @@ TclNRCoroutineActivateCallback(
/*
*----------------------------------------------------------------------
*
+ * TclNREvalList --
+ *
+ * Callback to invoke command as list, used in order to delayed
+ * processing of canonical list command in sane environment.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TclNREvalList(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ int objc;
+ Tcl_Obj **objv;
+ Tcl_Obj *listPtr = data[0];
+
+ Tcl_IncrRefCount(listPtr);
+
+ TclMarkTailcall(interp);
+ TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
+ TclListObjGetElements(NULL, listPtr, &objc, &objv);
+ return TclNREvalObjv(interp, objc, objv, 0, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* NRCoroInjectObjCmd --
*
* Implementation of [::tcl::unsupported::inject] command.
@@ -8821,7 +8850,8 @@ NRCoroInjectObjCmd(
*/
iPtr->execEnvPtr = corPtr->eePtr;
- TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
+ TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2),
+ NULL, NULL, NULL);
iPtr->execEnvPtr = savedEEPtr;
return TCL_OK;
diff --git a/library/clock.tcl b/library/clock.tcl
index 535a67d..535a67d 100755..100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
diff --git a/tests/coroutine.test b/tests/coroutine.test
index 86fa6e3..07feb53 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -741,6 +741,45 @@ test coroutine-7.12 {coro floor above street level #3008307} -body {
list
} -result {}
+test coroutine-8.0.0 {coro inject executed} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ demo
+ set ::result none
+ tcl::unsupported::inject demo set ::result inject-executed
+ demo
+ set ::result
+} -result {inject-executed}
+test coroutine-8.0.1 {coro inject after error} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield; error test }}
+ demo
+ set ::result none
+ tcl::unsupported::inject demo set ::result inject-executed
+ lappend ::result [catch {demo} err] $err
+} -result {inject-executed 1 test}
+test coroutine-8.1.1 {coro inject, ticket 42202ba1e5ff566e} -body {
+ interp create slave
+ slave eval {
+ coroutine demo apply {{} { while {1} yield }}
+ demo
+ tcl::unsupported::inject demo set ::result inject-executed
+ }
+ interp delete slave
+} -result {}
+test coroutine-8.1.2 {coro inject with result, ticket 42202ba1e5ff566e} -body {
+ interp create slave
+ slave eval {
+ coroutine demo apply {{} { while {1} yield }}
+ demo
+ tcl::unsupported::inject demo set ::result inject-executed
+ }
+ slave eval demo
+ set result [slave eval {set ::result}]
+
+ interp delete slave
+ set result
+} -result {inject-executed}
+
+
# cleanup
unset lambda
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index e61d619..e61d619 100755..100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c