diff options
author | dgp <dgp@users.sourceforge.net> | 2004-09-30 22:45:10 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2004-09-30 22:45:10 (GMT) |
commit | 5c16366d01d19e9cacbb662827823e070bc606cf (patch) | |
tree | 6b2ec1f6f1ea65672138439c60138372dcf4414c /generic/tclNamesp.c | |
parent | dd9bf5efaf27ae22d4c80c1e55bf79c422fb061c (diff) | |
download | tcl-5c16366d01d19e9cacbb662827823e070bc606cf.zip tcl-5c16366d01d19e9cacbb662827823e070bc606cf.tar.gz tcl-5c16366d01d19e9cacbb662827823e070bc606cf.tar.bz2 |
* generic/tclNamespace.c (TclTeardownNamespace): Tcl_Obj-ified
* tests/namespace.test (namespace-8.5,6): the save/restore
of ::errorInfo and ::errorCode during global namespace teardown.
Revised the comment to clarify why this is done, and added tests
that will fail if this is not done.
* generic/tclResult.c (TclTransferResult): Added safety
checks so that unexpected undefined ::errorInfo or ::errorCode
will not lead to a segfault.
* generic/tclVar.c (CallVarTraces): Save/restore the flag
* tests/var.test (var-16.1): values that define part of the
interpreter state during variable traces. [Bug 10381021].
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r-- | generic/tclNamesp.c | 58 |
1 files changed, 25 insertions, 33 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 7e238d0..d319100 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -19,7 +19,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.31.2.4 2004/09/10 18:22:09 dgp Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.5 2004/09/30 22:45:14 dgp Exp $ */ #include "tclInt.h" @@ -713,45 +713,37 @@ TclTeardownNamespace(nsPtr) if (nsPtr == globalNsPtr) { /* - * This is the global namespace, so be careful to preserve the - * "errorInfo" and "errorCode" variables. These might be needed - * later on if errors occur while deleting commands. We are careful - * to destroy and recreate the "errorInfo" and "errorCode" - * variables, in case they had any traces on them. + * This is the global namespace. Tearing it down will destroy the + * ::errorInfo and ::errorCode variables. We save and restore them + * in case there are any errors in progress, so the error details + * they contain will not be lost. See test namespace-8.5 */ - CONST char *str; - char *errorInfoStr, *errorCodeStr; + Tcl_Obj *errorInfo = Tcl_GetVar2Ex(nsPtr->interp, "errorInfo", + NULL, TCL_GLOBAL_ONLY); + Tcl_Obj *errorCode = Tcl_GetVar2Ex(nsPtr->interp, "errorCode", + NULL, TCL_GLOBAL_ONLY); - str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorInfo", TCL_GLOBAL_ONLY); - if (str != NULL) { - errorInfoStr = ckalloc((unsigned) (strlen(str)+1)); - strcpy(errorInfoStr, str); - } else { - errorInfoStr = NULL; - } - - str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorCode", TCL_GLOBAL_ONLY); - if (str != NULL) { - errorCodeStr = ckalloc((unsigned) (strlen(str)+1)); - strcpy(errorCodeStr, str); - } else { - errorCodeStr = NULL; - } + if (errorInfo) { + Tcl_IncrRefCount(errorInfo); + } + if (errorCode) { + Tcl_IncrRefCount(errorCode); + } TclDeleteVars(iPtr, &nsPtr->varTable); Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS); - if (errorInfoStr != NULL) { - Tcl_SetVar((Tcl_Interp *) iPtr, "errorInfo", errorInfoStr, - TCL_GLOBAL_ONLY); - ckfree(errorInfoStr); - } - if (errorCodeStr != NULL) { - Tcl_SetVar((Tcl_Interp *) iPtr, "errorCode", errorCodeStr, - TCL_GLOBAL_ONLY); - ckfree(errorCodeStr); - } + if (errorInfo) { + Tcl_SetVar2Ex(nsPtr->interp, "errorInfo", NULL, + errorInfo, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(errorInfo); + } + if (errorCode) { + Tcl_SetVar2Ex(nsPtr->interp, "errorCode", NULL, + errorCode, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(errorCode); + } } else { /* * Variable table should be cleared but not freed! TclDeleteVars |