diff options
| author | dgp <dgp@users.sourceforge.net> | 2019-05-01 22:37:36 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2019-05-01 22:37:36 (GMT) |
| commit | 915cd6b66789a552437299e9047e9997c61461ca (patch) | |
| tree | 0647b2f6fceb27c3fd8c7284da910513968de7cc | |
| parent | d2dd1bf17dfc94f3f676b222c43ab227d789ea69 (diff) | |
| download | tcl-915cd6b66789a552437299e9047e9997c61461ca.zip tcl-915cd6b66789a552437299e9047e9997c61461ca.tar.gz tcl-915cd6b66789a552437299e9047e9997c61461ca.tar.bz2 | |
WIP
| -rw-r--r-- | generic/tclInt.h | 1 | ||||
| -rw-r--r-- | generic/tclLink.c | 12 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 7 |
3 files changed, 20 insertions, 0 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h index 3db1264..ed087fe 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3105,6 +3105,7 @@ MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); +MODULE_SCOPE int TclNamespaceDeleted(Tcl_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 8096c25..1ebfe6a 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -27,6 +27,7 @@ typedef struct Link { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ + Tcl_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 @@ -170,6 +171,7 @@ Tcl_LinkVar( linkPtr = ckalloc(sizeof(Link)); linkPtr->interp = interp; + linkPtr->nsPtr = NULL; linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; @@ -196,6 +198,11 @@ Tcl_LinkVar( LinkFree(linkPtr); return TCL_ERROR; } + + TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY, + &(linkPtr->nsPtr), + + code = Tcl_TraceVar2(interp, varName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); @@ -362,6 +369,8 @@ Tcl_LinkArray( linkPtr->interp = interp; linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); + + objPtr = ObjValue(linkPtr); if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { @@ -1497,6 +1506,9 @@ static void LinkFree( Link *linkPtr) /* Structure describing linked variable. */ { + if (linkPtr->nsPtr) { + TclNsDecrRefCount((Namespace *)(linkPtr->nsPtr)); + } if (linkPtr->flags & LINK_ALLOC_ADDR) { ckfree(linkPtr->addr); } diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index b553880..7e18568 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1086,6 +1086,13 @@ Tcl_DeleteNamespace( } TclNsDecrRefCount(nsPtr); } + +int +TclNamespaceDeleted( + Tcl_Namespace *nsPtr) +{ + return (((Namespace *) nsPtr)->flags & NS_DYING) ? 1 : 0; +} /* *---------------------------------------------------------------------- |