diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclExecute.c | 10 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 96 |
2 files changed, 53 insertions, 53 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 934a9fb..a738065 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,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.485 2010/06/05 16:24:26 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.486 2010/06/07 21:24:59 ferrieux Exp $ */ #include "tclInt.h" @@ -6419,11 +6419,9 @@ TclExecuteByteCode( } if ((TRESULT == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { bytes = GetSrcInfoForPc(pc, codePtr, &length); - if (bytes != NULL) { - DECACHE_STACK_INFO(); - Tcl_LogCommandInfo(interp, codePtr->source, bytes, length); - CACHE_STACK_INFO(); - } + DECACHE_STACK_INFO(); + Tcl_LogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0); + CACHE_STACK_INFO(); } iPtr->flags &= ~ERR_ALREADY_LOGGED; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 7422125..e09b52c 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -22,7 +22,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.207 2010/06/02 23:36:23 ferrieux Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.208 2010/06/07 21:25:00 ferrieux Exp $ */ #include "tclInt.h" @@ -4885,52 +4885,54 @@ Tcl_LogCommandInfo( return; } - /* - * Compute the line number where the error occurred. - */ - - iPtr->errorLine = 1; - for (p = script; p != command; p++) { - if (*p == '\n') { - iPtr->errorLine++; - } - } - - if (length < 0) { - length = strlen(command); - } - overflow = (length > limit); - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) - ? "while executing" : "invoked from within"), - (overflow ? limit : length), command, (overflow ? "..." : ""))); - - varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, - NULL, 0, 0, &arrayPtr); - if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) { - /* - * Should not happen. - */ - - return; - } else { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces, - (char *) varPtr); - VarTrace *tracePtr = Tcl_GetHashValue(hPtr); - - if (tracePtr->traceProc != EstablishErrorInfoTraces) { - /* - * The most recent trace set on ::errorInfo is not the one the - * core itself puts on last. This means some other code is tracing - * the variable, and the additional trace(s) might be write traces - * that expect the timing of writes to ::errorInfo that existed - * Tcl releases before 8.5. To satisfy that compatibility need, we - * write the current -errorinfo value to the ::errorInfo variable. - */ - - Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo, - TCL_GLOBAL_ONLY); - } + if (command != NULL) { + /* + * Compute the line number where the error occurred. + */ + + iPtr->errorLine = 1; + for (p = script; p != command; p++) { + if (*p == '\n') { + iPtr->errorLine++; + } + } + + if (length < 0) { + length = strlen(command); + } + overflow = (length > limit); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) + ? "while executing" : "invoked from within"), + (overflow ? limit : length), command, (overflow ? "..." : ""))); + + varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, + NULL, 0, 0, &arrayPtr); + if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) { + /* + * Should not happen. + */ + + return; + } else { + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) varPtr); + VarTrace *tracePtr = Tcl_GetHashValue(hPtr); + + if (tracePtr->traceProc != EstablishErrorInfoTraces) { + /* + * The most recent trace set on ::errorInfo is not the one the + * core itself puts on last. This means some other code is tracing + * the variable, and the additional trace(s) might be write traces + * that expect the timing of writes to ::errorInfo that existed + * Tcl releases before 8.5. To satisfy that compatibility need, we + * write the current -errorinfo value to the ::errorInfo variable. + */ + + Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo, + TCL_GLOBAL_ONLY); + } + } } /* |