Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | [8ff0cb9fe1] Make Tcl_NREvalObj() (and friends) behave as documented, by only scheduling evaluation and not doing any of it until the caller routine returns. This fixes some serious errors in [coroutine] too. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
ec51e0603e6e7adfae21ec62645616d2 |
User & Date: | dgp 2013-08-21 19:30:01 |
Context
2016-06-16
| ||
15:25 | Merge ec51e0603e. Segfaults again. check-in: 68fccd6611 user: dgp tags: bug-16828b3744 | |
2013-08-22
| ||
08:07 | Correction to documentation check-in: bb0a6db5e9 user: dkf tags: trunk | |
01:13 | merge trunk check-in: 7a2ab4dc79 user: dgp tags: bug-2502002 | |
01:10 | merge trunk check-in: 554b3422a1 user: dgp tags: dgp-refactor | |
2013-08-21
| ||
19:30 | [8ff0cb9fe1] Make Tcl_NREvalObj() (and friends) behave as documented, by only scheduling evaluation ... check-in: ec51e0603e user: dgp tags: trunk | |
19:18 | Tidy the code and add a test. Closed-Leaf check-in: 3f49eeab3d user: dgp tags: dgp-purge-NRRunObjProc | |
10:25 | [3612422]: Refer to correct part of tclvars(n) rather than page itself. check-in: a197e6853e user: dkf tags: trunk | |
Changes
Changes to generic/tclBasic.c.
︙ | ︙ | |||
129 130 131 132 133 134 135 | static Tcl_ObjCmdProc ExprWideFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); | < | 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | static Tcl_ObjCmdProc ExprWideFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, |
︙ | ︙ | |||
154 155 156 157 158 159 160 161 162 163 164 165 166 167 | static Tcl_NRPostProc TEOEx_ByteCodeCallback; static Tcl_NRPostProc TEOEx_ListCallback; static Tcl_NRPostProc TEOV_Error; static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_ObjCmdProc NRCoroInjectObjCmd; MODULE_SCOPE const TclStubs tclStubs; /* * Magical counts for the number of arguments accepted by a coroutine command | > | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | static Tcl_NRPostProc TEOEx_ByteCodeCallback; static Tcl_NRPostProc TEOEx_ListCallback; static Tcl_NRPostProc TEOV_Error; 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; MODULE_SCOPE const TclStubs tclStubs; /* * Magical counts for the number of arguments accepted by a coroutine command |
︙ | ︙ | |||
4228 4229 4230 4231 4232 4233 4234 | * Fix the original callback to point to the now known cmdPtr. Insure that * the Command struct lives until the command returns. */ *cmdPtrPtr = cmdPtr; cmdPtr->refCount++; | < > | > | > > > | > | > > > > < | < | 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 | * Fix the original callback to point to the now known cmdPtr. Insure that * the Command struct lives until the command returns. */ *cmdPtrPtr = cmdPtr; cmdPtr->refCount++; 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) { return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); } else { return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } } int TclNRRunCallbacks( |
︙ | ︙ | |||
4318 4319 4320 4321 4322 4323 4324 | } if (result == TCL_OK && TclLimitReady(iPtr->limit)) { result = Tcl_LimitCheck(interp); } return result; } | < < < < < < < < < < < < < < < < | 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 | } if (result == TCL_OK && TclLimitReady(iPtr->limit)) { result = Tcl_LimitCheck(interp); } return result; } /* *---------------------------------------------------------------------- * * TEOV_Exception - * TEOV_LookupCmdFromObj - * TEOV_RunEnterTraces - |
︙ | ︙ |
Changes to generic/tclOOBasic.c.
︙ | ︙ | |||
84 85 86 87 88 89 90 | ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); | | > | > > | | | > | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); Tcl_Obj **invoke; if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "?definitionScript?"); return TCL_ERROR; } else if (objc == Tcl_ObjectContextSkippedArgs(context)) { return TCL_OK; } /* * 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]; /* * Must add references or errors in configuration script will cause * trouble. */ Tcl_IncrRefCount(invoke[0]); Tcl_IncrRefCount(invoke[1]); Tcl_IncrRefCount(invoke[2]); TclNRAddCallback(interp, DecrRefsPostClassConstructor, invoke, NULL, NULL, NULL); /* * Tricky point: do not want the extra reported level in the Tcl stack * trace, so use TCL_EVAL_NOERR. */ return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL); } static int DecrRefsPostClassConstructor( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj **invoke = data[0]; TclDecrRefCount(invoke[0]); TclDecrRefCount(invoke[1]); TclDecrRefCount(invoke[2]); ckfree(invoke); return result; } /* * ---------------------------------------------------------------------- * * TclOO_Class_Create -- |
︙ | ︙ |
Changes to tests/coroutine.test.
︙ | ︙ | |||
605 606 607 608 609 610 611 612 613 614 615 616 617 618 | set result "" coroutine j1 juggler [coroutine j2 juggler [coroutine j3 juggler j1]]\ {a b c d e} list $result [info command j1] [info command j2] [info command j3] } -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} {} {} {}} # cleanup unset lambda ::tcltest::cleanupTests return | > > > > > > > > > | 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 | set result "" coroutine j1 juggler [coroutine j2 juggler [coroutine j3 juggler j1]]\ {a b c d e} list $result [info command j1] [info command j2] [info command j3] } -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 ::tcltest::cleanupTests return |
︙ | ︙ |