From 52b97dd00b18638dfeb1fea5dcc028759127b714 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 22 Aug 2013 08:07:33 +0000 Subject: Correction to documentation --- doc/Method.3 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/Method.3 b/doc/Method.3 index 43b3609..2537d5e 100644 --- a/doc/Method.3 +++ b/doc/Method.3 @@ -172,8 +172,9 @@ typedef struct { .PP The \fIversion\fR field allows for future expansion of the structure, and should always be declared equal to TCL_OO_METHOD_VERSION_CURRENT. The -\fIname\fR field provides a human-readable name for the type, and is reserved -for debugging. +\fIname\fR field provides a human-readable name for the type, and is the value +that is exposed via the \fBinfo class methodtype\fR and +\fBinfo object methodtype\fR Tcl commands. .PP The \fIcallProc\fR field gives a function that is called when the method is invoked; it must never be NULL. -- cgit v0.12 From a5b75dfa9a6ddadcf9f6a864bc47a1b5e69daed5 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 22 Aug 2013 13:01:31 +0000 Subject: More coroutine tests. --- tests/coroutine.test | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/coroutine.test b/tests/coroutine.test index faa5a42..8a7fdf3 100644 --- a/tests/coroutine.test +++ b/tests/coroutine.test @@ -618,6 +618,21 @@ test coroutine-7.4 {Bug 8ff0cb9fe1} -setup { coroutine demo lsort -command foo {a b} } -result {b a} +test coroutine-7.5 {return codes} { + set result {} + foreach code {0 1 2 3 4 5} { + lappend result [catch {coroutine demo return -level 0 -code $code}] + } + set result +} {0 1 2 3 4 5} + +test coroutine-7.6 {Early yield crashes} { + proc foo args {} + trace add execution foo enter {catch yield} + coroutine demo foo + rename foo {} +} {} + # cleanup unset lambda -- cgit v0.12 From 8173bccfd9b158ecd9f10dd7d9978a2b287fdcfe Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 22 Aug 2013 16:13:29 +0000 Subject: Remove assertion that is not true in some circumstances (--enable-dtrace). --- generic/tclExecute.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d066476..96004e2 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -8798,8 +8798,7 @@ TclGetSrcInfoForPc( &cfPtr->len, NULL, NULL); } - assert(cfPtr->cmd != NULL); - { + if (cfPtr->cmd != NULL) { /* * We now have the command. We can get the srcOffset back and from * there find the list of word locations for this command. -- cgit v0.12 From f7cf1b2bae1b15e6c6002405dbff659d2e8ac384 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 22 Aug 2013 20:21:15 +0000 Subject: Make Dispatch() the single point for calling a Tcl_ObjCmdProc, and attach the DTRACE machinery there (one place, not two). --- generic/tclBasic.c | 91 +++++++++++++++++++----------------------------------- 1 file changed, 32 insertions(+), 59 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c1032f9..5371f31 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4196,6 +4196,31 @@ TclNREvalObjv( } } + /* + * 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->nreProc ? cmdPtr->nreProc : cmdPtr->objProc, + cmdPtr->objClientData, INT2PTR(objc), objv); + return TCL_OK; +} + +static int +Dispatch( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Tcl_ObjCmdProc *objProc = data[0]; + ClientData clientData = data[1]; + int objc = PTR2INT(data[2]); + Tcl_Obj **objv = data[3]; + Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { @@ -4216,41 +4241,17 @@ TclNREvalObjv( TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); TclDecrRefCount(info); } - if (TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) { + if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) + && objc) { TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); } - if (TCL_DTRACE_CMD_ENTRY_ENABLED()) { + if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) { TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1, (Tcl_Obj **)(objv + 1)); } #endif /* USE_DTRACE */ - /* - * 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); - } + return objProc(clientData, interp, objc, objv); } int @@ -7981,39 +7982,11 @@ Tcl_NRCallObjProc( int objc, Tcl_Obj *const objv[]) { - int result = TCL_OK; NRE_callback *rootPtr = TOP_CB(interp); -#ifdef USE_DTRACE - if (TCL_DTRACE_CMD_ARGS_ENABLED()) { - const char *a[10]; - int i = 0; - - while (i < 10) { - a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; - } - TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], - a[8], a[9]); - } - if (TCL_DTRACE_CMD_INFO_ENABLED() && ((Interp *) interp)->cmdFramePtr) { - Tcl_Obj *info = TclInfoFrame(interp, ((Interp *) interp)->cmdFramePtr); - const char *a[6]; int i[2]; - - TclDTraceInfo(info, a, i); - TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); - TclDecrRefCount(info); - } - if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) - && objc) { - TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); - } - if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) { - TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1, - (Tcl_Obj **)(objv + 1)); - } -#endif /* USE_DTRACE */ - result = objProc(clientData, interp, objc, objv); - return TclNRRunCallbacks(interp, result, rootPtr); + TclNRAddCallback(interp, Dispatch, objProc, clientData, + INT2PTR(objc), objv); + return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } /* -- cgit v0.12 From 272b2008ad7da7b6bd2c559142d78d06f0030a67 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 22 Aug 2013 20:34:30 +0000 Subject: compiler warning --- generic/tclBasic.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 5371f31..fc449cc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4220,9 +4220,9 @@ Dispatch( ClientData clientData = data[1]; int objc = PTR2INT(data[2]); Tcl_Obj **objv = data[3]; +#ifdef USE_DTRACE Interp *iPtr = (Interp *) interp; -#ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { const char *a[10]; int i = 0; -- cgit v0.12