summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-06-16 15:25:55 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-06-16 15:25:55 (GMT)
commit5cd52c2f5ee0d3caf3b915f3b5e5158fc11e5dd8 (patch)
treec6b5ec676fc9652116e044991a18b13c96c53c7a
parent9899c6d8097c67a31bc107c77ff8848bcc23d6db (diff)
parent5fa41623af2f5fefeee57120e605c491d5dd4edd (diff)
downloadtcl-5cd52c2f5ee0d3caf3b915f3b5e5158fc11e5dd8.zip
tcl-5cd52c2f5ee0d3caf3b915f3b5e5158fc11e5dd8.tar.gz
tcl-5cd52c2f5ee0d3caf3b915f3b5e5158fc11e5dd8.tar.bz2
Merge ec51e0603e. Segfaults again.
-rw-r--r--generic/tclBasic.c39
-rw-r--r--generic/tclOOBasic.c14
-rw-r--r--tests/coroutine.test9
3 files changed, 33 insertions, 29 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 4a95340..c1032f9 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -133,7 +133,6 @@ static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
-static Tcl_NRPostProc NRRunObjProc;
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
static void ProcessUnexpectedResult(Tcl_Interp *interp,
@@ -158,6 +157,7 @@ static Tcl_NRPostProc TEOV_Exception;
static Tcl_NRPostProc TEOV_NotFoundCallback;
static Tcl_NRPostProc TEOV_RestoreVarFrame;
static Tcl_NRPostProc TEOV_RunLeaveTraces;
+static Tcl_NRPostProc Dispatch;
static Tcl_ObjCmdProc NRCoroInjectObjCmd;
@@ -4232,15 +4232,22 @@ TclNREvalObjv(
*cmdPtrPtr = cmdPtr;
cmdPtr->refCount++;
- /*
- * Find the objProc to call: nreProc if available, objProc otherwise. Push
- * a callback to do the actual running.
- */
+ TclNRAddCallback(interp, Dispatch, cmdPtr, INT2PTR(objc), objv, NULL);
+ return TCL_OK;
+}
+
+static int
+Dispatch(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Command *cmdPtr = data[0];
+ int objc = PTR2INT(data[1]);
+ Tcl_Obj **objv = data[2];
if (cmdPtr->nreProc) {
- TclNRAddCallback(interp, NRRunObjProc, cmdPtr,
- INT2PTR(objc), (ClientData) objv, NULL);
- return TCL_OK;
+ return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv);
} else {
return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
}
@@ -4322,22 +4329,6 @@ NRCommand(
return result;
}
-
-static int
-NRRunObjProc(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- /* OPT: do not call? */
-
- Command* cmdPtr = data[0];
- int objc = PTR2INT(data[1]);
- Tcl_Obj **objv = data[2];
-
- return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv);
-}
-
/*
*----------------------------------------------------------------------
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index f8cd1a4..aba06a5 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -88,7 +88,7 @@ TclOO_Class_Constructor(
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
- Tcl_Obj *invoke[3];
+ Tcl_Obj **invoke;
if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -102,6 +102,7 @@ TclOO_Class_Constructor(
* Delegate to [oo::define] to do the work.
*/
+ invoke = ckalloc(3 * sizeof(Tcl_Obj *));
invoke[0] = oPtr->fPtr->defineName;
invoke[1] = TclOOObjectName(interp, oPtr);
invoke[2] = objv[objc-1];
@@ -115,7 +116,7 @@ TclOO_Class_Constructor(
Tcl_IncrRefCount(invoke[1]);
Tcl_IncrRefCount(invoke[2]);
TclNRAddCallback(interp, DecrRefsPostClassConstructor,
- invoke[0], invoke[1], invoke[2], NULL);
+ invoke, NULL, NULL, NULL);
/*
* Tricky point: do not want the extra reported level in the Tcl stack
@@ -131,9 +132,12 @@ DecrRefsPostClassConstructor(
Tcl_Interp *interp,
int result)
{
- TclDecrRefCount((Tcl_Obj *) data[0]);
- TclDecrRefCount((Tcl_Obj *) data[1]);
- TclDecrRefCount((Tcl_Obj *) data[2]);
+ Tcl_Obj **invoke = data[0];
+
+ TclDecrRefCount(invoke[0]);
+ TclDecrRefCount(invoke[1]);
+ TclDecrRefCount(invoke[2]);
+ ckfree(invoke);
return result;
}
diff --git a/tests/coroutine.test b/tests/coroutine.test
index 1d9040b..faa5a42 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -609,6 +609,15 @@ test coroutine-7.3 {yielding between coroutines} -body {
} -cleanup {
catch {rename juggler ""}
} -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}
+
+test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
+ proc foo {a b} {catch yield; return 1}
+} -cleanup {
+ rename foo {}
+} -body {
+ coroutine demo lsort -command foo {a b}
+} -result {b a}
+
# cleanup
unset lambda