diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclBasic.c | 16 | ||||
| -rw-r--r-- | generic/tclCompile.c | 11 | ||||
| -rw-r--r-- | generic/tclExecute.c | 7 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 3 |
5 files changed, 16 insertions, 30 deletions
@@ -1,5 +1,14 @@ 2004-09-21 Don Porter <dgp@users.sourceforge.net> + * generic/tclBasic.c: Reworked management of the interp + * generic/tclCompile.c: flag ERR_ALREADY_LOGGED, to reduce + * generic/tclExecute.c: its exposure. Still left several + * generic/tclNamesp.c: references that are just too nice + on performace to do away with. These changes also resolve + an inconsistency in the ::errorInfo values produced by + [namespace eval x error foo bar] and + [namespace eval x {error foo bar}]. + * generic/tclExecute.c (TclCompEvalObj): Simplified the TclCompEvalObj routine. Much housekeeping now reliably happens elsewhere. [Patch 1031949] diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f6e5235..aabcb27 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.114 2004/09/17 22:59:14 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.115 2004/09/21 22:45:40 dgp Exp $ */ #include "tclInt.h" @@ -3311,7 +3311,6 @@ Tcl_LogCommandInfo(interp, script, command, length) if (!(iPtr->flags & ERROR_CODE_SET)) { Tcl_SetErrorCode(interp, "NONE", NULL); } - iPtr->flags &= ~ERR_ALREADY_LOGGED; } /* @@ -3837,17 +3836,8 @@ Tcl_EvalObjEx(interp, objPtr, flags) && !allowExceptions) { ProcessUnexpectedResult(interp, result); result = TCL_ERROR; - - /* - * If an error was created here, record information about - * what was being executed when the error occurred. - */ - - if (!(iPtr->flags & ERR_ALREADY_LOGGED)) { - script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); - Tcl_LogCommandInfo(interp, script, script, numSrcBytes); - iPtr->flags &= ~ERR_ALREADY_LOGGED; - } + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + Tcl_LogCommandInfo(interp, script, script, numSrcBytes); } } iPtr->evalFlags = 0; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 03b62ca..8682429 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.71 2004/07/15 17:42:12 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.72 2004/09/21 22:45:41 dgp Exp $ */ #include "tclInt.h" @@ -1807,15 +1807,6 @@ LogCompilationInfo(interp, script, command, length) Interp *iPtr = (Interp *) interp; Tcl_Obj *message; - if (iPtr->flags & ERR_ALREADY_LOGGED) { - /* - * Someone else has already logged error information for this - * command; we shouldn't add anything more. - */ - - return; - } - /* * Compute the line number where the error occurred. */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index dc6520a..b7edcf2 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.150 2004/09/21 21:14:03 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.151 2004/09/21 22:45:41 dgp Exp $ */ #ifdef STDC_HEADERS @@ -907,13 +907,9 @@ TclCompEvalObj(interp, objPtr) { register Interp *iPtr = (Interp *) interp; register ByteCode* codePtr; /* Tcl Internal type of bytecode. */ - int oldCount = iPtr->cmdCount; /* Used to tell whether any commands - * at all were executed. */ - char *script; int result; Namespace *namespacePtr; - /* * Check that the interpreter is ready to execute scripts */ @@ -1006,7 +1002,6 @@ TclCompEvalObj(interp, objPtr) TclCleanupByteCode(codePtr); } iPtr->numLevels--; - iPtr->flags &= ~ERR_ALREADY_LOGGED; return result; } diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 1ad687c..902d5d6 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -21,7 +21,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.53 2004/09/13 10:49:19 dkf Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.54 2004/09/21 22:45:42 dgp Exp $ */ #include "tclInt.h" @@ -515,6 +515,7 @@ Tcl_PopCallFrame(interp) } iPtr->flags |= saveErrFlag; + iPtr->flags &= ~ERR_ALREADY_LOGGED; /* * Decrement the namespace's count of active call frames. If the |