From 7f660cabfb7f9a21f1a60e6e2b06cbd9449b8d13 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 107aa17d8d2388a56f1fd3374e8b49b135e1ae41 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 3f61f168eb9d98c28312cdea25b214827c3692f2 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 21 Aug 2013 10:25:18 +0000 Subject: [3612422]: Refer to correct part of tclvars(n) rather than page itself. --- doc/AddErrInfo.3 | 12 ++++++------ doc/CrtInterp.3 | 7 ++++--- doc/Environment.3 | 2 +- doc/bgerror.n | 5 ++++- doc/binary.n | 2 +- doc/catch.n | 3 ++- doc/eval.n | 3 ++- doc/info.n | 12 ++++++------ doc/library.n | 10 +++++++--- doc/return.n | 4 ++-- doc/tclsh.1 | 8 +++++--- doc/throw.n | 2 +- 12 files changed, 41 insertions(+), 29 deletions(-) diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index b9c6a63..36f6a20 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -176,16 +176,16 @@ these return options. The \fB\-errorinfo\fR option holds a stack trace of the operations that were in progress when an error occurred, and is intended to be human-readable. -The \fB\-errorcode\fR option holds a list of items that +The \fB\-errorcode\fR option holds a Tcl list of items that are intended to be machine-readable. The first item in the \fB\-errorcode\fR value identifies the class of error that occurred -(e.g. POSIX means an error occurred in a POSIX system call) +(e.g., POSIX means an error occurred in a POSIX system call) and additional elements hold additional pieces of information that depend on the class. -See the \fBtclvars\fR manual entry for details on the various -formats for the \fB\-errorcode\fR option used by -Tcl's built-in commands. +See the manual entry on the \fBerrorCode\fR variable for details on the +various formats for the \fB\-errorcode\fR option used by Tcl's built-in +commands. .PP The \fB\-errorinfo\fR option value is gradually built up as an error unwinds through the nested operations. @@ -307,6 +307,6 @@ so they continue to hold a record of information about the most recent error seen in an interpreter. .SH "SEE ALSO" Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3), -Tcl_SetErrno(3), tclvars(n) +Tcl_SetErrno(3), errorCode(n), errorInfo(n) .SH KEYWORDS error, value, value result, stack, trace, variable diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index a248cf4..1156a20 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -41,8 +41,9 @@ may only be passed to Tcl routines called from the same thread as the original \fBTcl_CreateInterp\fR call. It is not safe for multiple threads to pass the same token to Tcl's routines. The new interpreter is initialized with the built-in Tcl commands -and with the variables documented in the \fBtclvars\fR manual page. To bind in -additional commands, call \fBTcl_CreateCommand\fR. +and with standard variables like \fBtcl_platform\fR and \fBenv\fR. To +bind in additional commands, call \fBTcl_CreateCommand\fR, and to +create additional variables, call \fBTcl_SetVar\fR. .PP \fBTcl_DeleteInterp\fR marks an interpreter as deleted; the interpreter will eventually be deleted when all calls to \fBTcl_Preserve\fR for it have @@ -144,6 +145,6 @@ should be used to determine when an interpreter is a candidate for deletion due to inactivity. .VE 8.6 .SH "SEE ALSO" -Tcl_Preserve(3), Tcl_Release(3), tclvars(n) +Tcl_Preserve(3), Tcl_Release(3) .SH KEYWORDS command, create, delete, interpreter diff --git a/doc/Environment.3 b/doc/Environment.3 index 3753f43..46262ab 100644 --- a/doc/Environment.3 +++ b/doc/Environment.3 @@ -33,6 +33,6 @@ Tcl-based applications using \fBputenv\fR should redefine it to \fBTcl_PutEnv\fR so that they will interface properly to the Tcl runtime. .SH "SEE ALSO" -tclvars(n) +env(n) .SH KEYWORDS environment, variable diff --git a/doc/bgerror.n b/doc/bgerror.n index ac53eca..16a23a3 100644 --- a/doc/bgerror.n +++ b/doc/bgerror.n @@ -85,6 +85,9 @@ proc bgerror {message} { } .CE .SH "SEE ALSO" -after(n), interp(n), tclvars(n) +after(n), errorCode(n), errorInfo(n), interp(n) .SH KEYWORDS background error, reporting +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/binary.n b/doc/binary.n index 68bf9cc..a40afe6 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -884,7 +884,7 @@ close $f puts [\fBbinary encode\fR base64 \-maxlen 64 $data] .CE .SH "SEE ALSO" -format(n), scan(n), tclvars(n) +format(n), scan(n), tcl_platform(n) .SH KEYWORDS binary, format, scan '\" Local Variables: diff --git a/doc/catch.n b/doc/catch.n index a05ca71..9597ccf 100644 --- a/doc/catch.n +++ b/doc/catch.n @@ -115,7 +115,8 @@ if { [\fBcatch\fR {open $someFile w} fid] } { There are more complex examples of \fBcatch\fR usage in the documentation for the \fBreturn\fR command. .SH "SEE ALSO" -break(n), continue(n), dict(n), error(n), info(n), return(n), tclvars(n) +break(n), continue(n), dict(n), error(n), errorCode(n), errorInfo(n), info(n), +return(n) .SH KEYWORDS catch, error, exception '\" Local Variables: diff --git a/doc/eval.n b/doc/eval.n index da88757..13b54be 100644 --- a/doc/eval.n +++ b/doc/eval.n @@ -75,7 +75,8 @@ However, the last line would now normally be written without set var [linsert $var 0 {*}$args] .CE .SH "SEE ALSO" -catch(n), concat(n), error(n), interp(n), list(n), namespace(n), subst(n), tclvars(n), uplevel(n) +catch(n), concat(n), error(n), errorCode(n), errorInfo(n), interp(n), list(n), +namespace(n), subst(n), uplevel(n) .SH KEYWORDS concatenate, evaluate, script '\" Local Variables: diff --git a/doc/info.n b/doc/info.n index e65a083..14a9e50 100644 --- a/doc/info.n +++ b/doc/info.n @@ -296,7 +296,6 @@ Returns the name of the library directory in which standard Tcl scripts are stored. This is actually the value of the \fBtcl_library\fR variable and may be changed by setting \fBtcl_library\fR. -See the \fBtclvars\fR manual entry for more information. .TP \fBinfo loaded \fR?\fIinterp\fR? . @@ -336,8 +335,8 @@ described in \fBOBJECT INTROSPECTION\fR below. .TP \fBinfo patchlevel\fR . -Returns the value of the global variable \fBtcl_patchLevel\fR; see -the \fBtclvars\fR manual entry for more information. +Returns the value of the global variable \fBtcl_patchLevel\fR, which holds +the exact version of the Tcl library by default. .TP \fBinfo procs \fR?\fIpattern\fR? . @@ -374,8 +373,8 @@ string is returned. .TP \fBinfo tclversion\fR . -Returns the value of the global variable \fBtcl_version\fR; see -the \fBtclvars\fR manual entry for more information. +Returns the value of the global variable \fBtcl_version\fR, which holds the +major and minor version of the Tcl library by default. .TP \fBinfo vars\fR ?\fIpattern\fR? . @@ -763,8 +762,9 @@ proc getDef {obj method} { .VE 8.6 .SH "SEE ALSO" .VS 8.6 -global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n) +global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n), .VE 8.6 +tcl_library(n), tcl_patchLevel(n), tcl_version(n) .SH KEYWORDS command, information, interpreter, introspection, level, namespace, .VS 8.6 diff --git a/doc/library.n b/doc/library.n index 2413692..98dcb35 100644 --- a/doc/library.n +++ b/doc/library.n @@ -262,13 +262,17 @@ If set to any value, then \fBunknown\fR will not attempt to auto-load any commands. .TP \fBauto_path\fR +. If set, then it must contain a valid Tcl list giving directories to -search during auto-load operations. +search during auto-load operations (including for package index +files when using the default \fBpackage unknown\fR handler). This variable is initialized during startup to contain, in order: the directories listed in the \fBTCLLIBPATH\fR environment variable, -the directory named by the \fBtcl_library\fR variable, +the directory named by the \fBtcl_library\fR global variable, the parent directory of \fBtcl_library\fR, the directories listed in the \fBtcl_pkgPath\fR variable. +Additional locations to look for files and package indices should +normally be added to this variable using \fBlappend\fR. .TP \fBenv(TCL_LIBRARY)\fR If set, then it specifies the location of the directory containing @@ -306,7 +310,7 @@ considered to be a word character. On Windows platforms, words are comprised of any character that is not a space, tab, or newline. Under Unix, words are comprised of numbers, letters or underscores. .SH "SEE ALSO" -info(n), re_syntax(n), tclvars(n) +env(n), info(n), re_syntax(n) .SH KEYWORDS auto-exec, auto-load, library, unknown, word, whitespace '\"Local Variables: diff --git a/doc/return.n b/doc/return.n index b59a93d..a1abccf 100644 --- a/doc/return.n +++ b/doc/return.n @@ -317,8 +317,8 @@ proc myReturn {args} { } .CE .SH "SEE ALSO" -break(n), catch(n), continue(n), dict(n), error(n), proc(n), -source(n), tclvars(n), throw(n), try(n) +break(n), catch(n), continue(n), dict(n), error(n), errorCode(n), +errorInfo(n), proc(n), source(n), throw(n), try(n) .SH KEYWORDS break, catch, continue, error, exception, procedure, result, return .\" Local Variables: diff --git a/doc/tclsh.1 b/doc/tclsh.1 index 8e7fb9e..dfc2635 100644 --- a/doc/tclsh.1 +++ b/doc/tclsh.1 @@ -102,7 +102,9 @@ but also the disadvantage of making it harder to write scripts that start up uniformly across different versions of Tcl. .SH "VARIABLES" .PP -\fBTclsh\fR sets the following Tcl variables: +\fBTclsh\fR sets the following global Tcl variables in addition to those +created by the Tcl library itself (such as \fBenv\fR, which maps +environment variables such as \fBPATH\fR into Tcl): .TP 15 \fBargc\fR . @@ -129,7 +131,7 @@ device), 0 otherwise. When \fBtclsh\fR is invoked interactively it normally prompts for each command with .QW "\fB% \fR" . -You can change the prompt by setting the +You can change the prompt by setting the global variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR. If variable \fBtcl_prompt1\fR exists then it must consist of a Tcl script to output a prompt; instead of outputting a prompt \fBtclsh\fR @@ -142,6 +144,6 @@ incomplete commands. .PP See \fBTcl_StandardChannels\fR for more explanations. .SH "SEE ALSO" -encoding(n), fconfigure(n), tclvars(n) +auto_path(n), encoding(n), env(n), fconfigure(n) .SH KEYWORDS application, argument, interpreter, prompt, script file, shell diff --git a/doc/throw.n b/doc/throw.n index d49fb24..b28f2e4 100644 --- a/doc/throw.n +++ b/doc/throw.n @@ -40,7 +40,7 @@ The following produces an error that is identical to that produced by \fBthrow\fR {ARITH DIVZERO {divide by zero}} {divide by zero} .CE .SH "SEE ALSO" -catch(n), error(n), return(n), tclvars(n), try(n) +catch(n), error(n), errorCode(n), errorInfo(n), return(n), try(n) .SH "KEYWORDS" error, exception '\" Local Variables: -- cgit v0.12 From b9100f680a4f29439312a01ce54c8340b5d53374 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 88f6a82f096bab2c48289cf27f99c6f2df66da9b 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 cb779b2f4466180ab1678cc0a9e38159704b7efd 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