From a6f2dee7fbd4c79aabb8e7533d20d042eb7062c1 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 19 Aug 2013 15:22:15 +0000 Subject: Testing doing away with the NRRunObjProc routine, which looks like a useless extra bounce on the NRE trampoline. Normal testing has no problem with it, but debug-enabled testing triggers an assert failure. Either it would be good to have a normal test that fails in the conditions of the assert failure, or it would be good to discover the assert is asserting something not actually required, and then make the purge. --- generic/tclBasic.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4a95340..020f2f2 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -133,7 +133,9 @@ static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); +#if 0 static Tcl_NRPostProc NRRunObjProc; +#endif static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, @@ -4238,9 +4240,13 @@ TclNREvalObjv( */ if (cmdPtr->nreProc) { +#if 0 TclNRAddCallback(interp, NRRunObjProc, cmdPtr, INT2PTR(objc), (ClientData) objv, NULL); return TCL_OK; +#else + return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); +#endif } else { return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } @@ -4323,6 +4329,7 @@ NRCommand( return result; } +#if 0 static int NRRunObjProc( ClientData data[], @@ -4337,6 +4344,7 @@ NRRunObjProc( return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); } +#endif /* -- cgit v0.12 From 4bf79aef9b62990cea9c4069d86c25a45790f096 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 20 Aug 2013 14:00:05 +0000 Subject: Push out a trial patch for more eyes to see. --- generic/tclBasic.c | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 020f2f2..ca49bec 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -161,6 +161,8 @@ static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; +static Tcl_NRPostProc Dispatch; + static Tcl_ObjCmdProc NRCoroInjectObjCmd; MODULE_SCOPE const TclStubs tclStubs; @@ -4234,6 +4236,9 @@ TclNREvalObjv( *cmdPtrPtr = cmdPtr; cmdPtr->refCount++; + TclNRAddCallback(interp, Dispatch, cmdPtr, INT2PTR(objc), objv, NULL); + return TCL_OK; + /* * Find the objProc to call: nreProc if available, objProc otherwise. Push * a callback to do the actual running. @@ -4252,6 +4257,23 @@ TclNREvalObjv( } } +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) { + return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); + } else { + return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); + } +} + int TclNRRunCallbacks( Tcl_Interp *interp, -- cgit v0.12 From f18c1126d55725786c4ba524c310c989adbe15c5 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 21 Aug 2013 18:27:23 +0000 Subject: Don't use automatic storage to hold the invocation words of oo::define. That practice doesn't agree with NRE execution. --- generic/tclOOBasic.c | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index f8cd1a4..073abab 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 = ckalloc(3 * sizeof(Tcl_Obj *)); if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, @@ -115,7 +115,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 +131,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; } -- cgit v0.12 From 83d427e824792fee386b4dc5699858922a3cc3c2 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 21 Aug 2013 19:00:17 +0000 Subject: Don't allocate memory until you know you're going to use it and arrange for it to be freed. Leak! --- generic/tclOOBasic.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 073abab..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 = ckalloc(3 * sizeof(Tcl_Obj *)); + 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]; -- cgit v0.12 From ed72e77b7de9b2427769b37d8f669b1f05d9ee42 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 21 Aug 2013 19:18:28 +0000 Subject: Tidy the code and add a test. --- generic/tclBasic.c | 39 --------------------------------------- tests/coroutine.test | 9 +++++++++ 2 files changed, 9 insertions(+), 39 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index ca49bec..c1032f9 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -133,9 +133,6 @@ static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); -#if 0 -static Tcl_NRPostProc NRRunObjProc; -#endif static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, @@ -160,7 +157,6 @@ 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; @@ -4238,23 +4234,6 @@ TclNREvalObjv( TclNRAddCallback(interp, Dispatch, cmdPtr, INT2PTR(objc), objv, NULL); return TCL_OK; - - /* - * Find the objProc to call: nreProc if available, objProc otherwise. Push - * a callback to do the actual running. - */ - - if (cmdPtr->nreProc) { -#if 0 - TclNRAddCallback(interp, NRRunObjProc, cmdPtr, - INT2PTR(objc), (ClientData) objv, NULL); - return TCL_OK; -#else - return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); -#endif - } else { - return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); - } } static int @@ -4350,24 +4329,6 @@ NRCommand( return result; } - -#if 0 -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); -} -#endif - /* *---------------------------------------------------------------------- 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 -- cgit v0.12