diff options
| -rw-r--r-- | generic/tclInt.h | 2 | ||||
| -rw-r--r-- | generic/tclLink.c | 18 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 34 |
3 files changed, 53 insertions, 1 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h index e37727d..57367fa 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2638,6 +2638,8 @@ MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); MODULE_SCOPE int TclNokia770Doubles(); +MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); +MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const char *operation, const char *reason, int index); diff --git a/generic/tclLink.c b/generic/tclLink.c index 2dc2e47..7283d78 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -23,6 +23,7 @@ typedef struct Link { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ + Namespace *nsPtr; /* Namespace containing Tcl variable */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the * actual variable may be aliased at that time @@ -114,6 +115,8 @@ Tcl_LinkVar( { Tcl_Obj *objPtr; Link *linkPtr; + Namespace *dummy; + const char *name; int code; linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, @@ -126,6 +129,7 @@ Tcl_LinkVar( linkPtr = (Link *) ckalloc(sizeof(Link)); linkPtr->interp = interp; + linkPtr->nsPtr = NULL; linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; @@ -142,11 +146,17 @@ Tcl_LinkVar( ckfree((char *) linkPtr); return TCL_ERROR; } + + TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY, + &(linkPtr->nsPtr), &dummy, &dummy, &name); + linkPtr->nsPtr->refCount++; + code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); if (code != TCL_OK) { Tcl_DecrRefCount(linkPtr->varName); + TclNsDecrRefCount(linkPtr->nsPtr); ckfree((char *) linkPtr); } return code; @@ -186,6 +196,9 @@ Tcl_UnlinkVar( TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); Tcl_DecrRefCount(linkPtr->varName); + if (linkPtr->nsPtr) { + TclNsDecrRefCount(linkPtr->nsPtr); + } ckfree((char *) linkPtr); } @@ -279,8 +292,11 @@ LinkTraceProc( */ if (flags & TCL_TRACE_UNSETS) { - if (Tcl_InterpDeleted(interp)) { + if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) { Tcl_DecrRefCount(linkPtr->varName); + if (linkPtr->nsPtr) { + TclNsDecrRefCount(linkPtr->nsPtr); + } ckfree((char *) linkPtr); } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index a2e625e..a476b4e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1060,6 +1060,13 @@ Tcl_DeleteNamespace( } } } + +int +TclNamespaceDeleted( + Namespace *nsPtr) +{ + return (nsPtr->flags & NS_DYING) ? 1 : 0; +} /* *---------------------------------------------------------------------- @@ -1240,6 +1247,33 @@ NamespaceFree( /* *---------------------------------------------------------------------- * + * TclNsDecrRefCount -- + * + * Drops a reference to a namespace and frees it if the namespace has + * been deleted and the last reference has just been dropped. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclNsDecrRefCount( + Namespace *nsPtr) +{ + nsPtr->refCount--; + if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) { + NamespaceFree(nsPtr); + } +} + +/* + *---------------------------------------------------------------------- + * * Tcl_Export -- * * Makes all the commands matching a pattern available to later be |