diff options
author | dgp <dgp@noemail.net> | 2011-06-21 14:09:31 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2011-06-21 14:09:31 (GMT) |
commit | 1adb2560610112a9a3fe09d7506cdaaf676672d8 (patch) | |
tree | 429c7a079c9e330badf90fa60fbe2fd7f46f64f1 /generic/tclLink.c | |
parent | 1315f1024783fbc087753fbb2b06a04c3fbed18b (diff) | |
download | tcl-1adb2560610112a9a3fe09d7506cdaaf676672d8.zip tcl-1adb2560610112a9a3fe09d7506cdaaf676672d8.tar.gz tcl-1adb2560610112a9a3fe09d7506cdaaf676672d8.tar.bz2 |
3317466 Prevent multiple Tcl_LinkVar() links to a single Tcl variable.
FossilOrigin-Name: 39eb20d6a2249d4b28ab2749c9d63dd20662327b
Diffstat (limited to 'generic/tclLink.c')
-rw-r--r-- | generic/tclLink.c | 8 |
1 files changed, 8 insertions, 0 deletions
diff --git a/generic/tclLink.c b/generic/tclLink.c index df8b16a..f7911a4 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -112,6 +112,14 @@ Tcl_LinkVar( Link *linkPtr; int code; + linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, + LinkTraceProc, (ClientData) NULL); + if (linkPtr != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "variable '%s' is already linked", varName)); + return TCL_ERROR; + } + linkPtr = (Link *) ckalloc(sizeof(Link)); linkPtr->interp = interp; linkPtr->varName = Tcl_NewStringObj(varName, -1); |