summaryrefslogtreecommitdiffstats
path: root/generic/tclLink.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclLink.c')
-rw-r--r--generic/tclLink.c71
1 files changed, 39 insertions, 32 deletions
diff --git a/generic/tclLink.c b/generic/tclLink.c
index d4a7f38..2735256 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLink.c,v 1.25 2008/04/27 22:21:30 dkf Exp $
*/
#include "tclInt.h"
@@ -114,7 +112,15 @@ Tcl_LinkVar(
Link *linkPtr;
int code;
- linkPtr = (Link *) ckalloc(sizeof(Link));
+ linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL);
+ if (linkPtr != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "variable '%s' is already linked", varName));
+ return TCL_ERROR;
+ }
+
+ linkPtr = ckalloc(sizeof(Link));
linkPtr->interp = interp;
linkPtr->varName = Tcl_NewStringObj(varName, -1);
Tcl_IncrRefCount(linkPtr->varName);
@@ -129,14 +135,15 @@ Tcl_LinkVar(
if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
return TCL_ERROR;
}
- code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
- |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
+ code = Tcl_TraceVar2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ LinkTraceProc, linkPtr);
if (code != TCL_OK) {
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
}
return code;
}
@@ -164,17 +171,17 @@ Tcl_UnlinkVar(
Tcl_Interp *interp, /* Interpreter containing variable to unlink */
const char *varName) /* Global variable in interp to unlink. */
{
- Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName,
+ Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
if (linkPtr == NULL) {
return;
}
- Tcl_UntraceVar(interp, varName,
+ Tcl_UntraceVar2(interp, varName, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
LinkTraceProc, linkPtr);
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
}
/*
@@ -201,7 +208,7 @@ Tcl_UpdateLinkedVar(
Tcl_Interp *interp, /* Interpreter containing variable. */
const char *varName) /* Name of global variable that is linked. */
{
- Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName,
+ Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
int savedFlag;
@@ -215,8 +222,8 @@ Tcl_UpdateLinkedVar(
/*
* Callback may have unlinked the variable. [Bug 1740631]
*/
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, NULL);
+ linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
if (linkPtr != NULL) {
linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
}
@@ -268,11 +275,11 @@ LinkTraceProc(
if (flags & TCL_TRACE_UNSETS) {
if (Tcl_InterpDeleted(interp)) {
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
} else if (flags & TCL_TRACE_DESTROYED) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
+ Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
}
@@ -337,7 +344,7 @@ LinkTraceProc(
changed = 1;
break;
default:
- return "internal error: bad linked variable type";
+ return (char *) "internal error: bad linked variable type";
}
if (changed) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -358,7 +365,7 @@ LinkTraceProc(
if (linkPtr->flags & LINK_READ_ONLY) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "linked variable is read-only";
+ return (char *) "linked variable is read-only";
}
valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
if (valueObj == NULL) {
@@ -366,7 +373,7 @@ LinkTraceProc(
* This shouldn't ever happen.
*/
- return "internal error: linked variable couldn't be read";
+ return (char *) "internal error: linked variable couldn't be read";
}
switch (linkPtr->type) {
@@ -375,7 +382,7 @@ LinkTraceProc(
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have integer value";
+ return (char *) "variable must have integer value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
@@ -385,7 +392,7 @@ LinkTraceProc(
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have integer value";
+ return (char *) "variable must have integer value";
}
LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
break;
@@ -398,7 +405,7 @@ LinkTraceProc(
#endif
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return "variable must have real value";
+ return (char *) "variable must have real value";
#ifdef ACCEPT_NAN
}
linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
@@ -412,7 +419,7 @@ LinkTraceProc(
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have boolean value";
+ return (char *) "variable must have boolean value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
@@ -422,7 +429,7 @@ LinkTraceProc(
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have char value";
+ return (char *) "variable must have char value";
}
linkPtr->lastValue.c = (char)valueInt;
LinkedVar(char) = linkPtr->lastValue.c;
@@ -433,7 +440,7 @@ LinkTraceProc(
|| valueInt < 0 || valueInt > UCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned char value";
+ return (char *) "variable must have unsigned char value";
}
linkPtr->lastValue.uc = (unsigned char) valueInt;
LinkedVar(unsigned char) = linkPtr->lastValue.uc;
@@ -444,7 +451,7 @@ LinkTraceProc(
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have short value";
+ return (char *) "variable must have short value";
}
linkPtr->lastValue.s = (short)valueInt;
LinkedVar(short) = linkPtr->lastValue.s;
@@ -455,7 +462,7 @@ LinkTraceProc(
|| valueInt < 0 || valueInt > USHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned short value";
+ return (char *) "variable must have unsigned short value";
}
linkPtr->lastValue.us = (unsigned short)valueInt;
LinkedVar(unsigned short) = linkPtr->lastValue.us;
@@ -466,7 +473,7 @@ LinkTraceProc(
|| valueWide < 0 || valueWide > UINT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned int value";
+ return (char *) "variable must have unsigned int value";
}
linkPtr->lastValue.ui = (unsigned int)valueWide;
LinkedVar(unsigned int) = linkPtr->lastValue.ui;
@@ -477,7 +484,7 @@ LinkTraceProc(
|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have long value";
+ return (char *) "variable must have long value";
}
linkPtr->lastValue.l = (long)valueWide;
LinkedVar(long) = linkPtr->lastValue.l;
@@ -488,7 +495,7 @@ LinkTraceProc(
|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned long value";
+ return (char *) "variable must have unsigned long value";
}
linkPtr->lastValue.ul = (unsigned long)valueWide;
LinkedVar(unsigned long) = linkPtr->lastValue.ul;
@@ -501,7 +508,7 @@ LinkTraceProc(
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned wide int value";
+ return (char *) "variable must have unsigned wide int value";
}
linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
@@ -512,7 +519,7 @@ LinkTraceProc(
|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have float value";
+ return (char *) "variable must have float value";
}
linkPtr->lastValue.f = (float)valueDouble;
LinkedVar(float) = linkPtr->lastValue.f;
@@ -528,7 +535,7 @@ LinkTraceProc(
break;
default:
- return "internal error: bad linked variable type";
+ return (char *) "internal error: bad linked variable type";
}
return NULL;
}
generated by cgit v0.12 at 2025-10-21 21:10:40 (GMT)