summaryrefslogtreecommitdiffstats
path: root/generic/tclLink.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclLink.c')
-rw-r--r--generic/tclLink.c130
1 files changed, 65 insertions, 65 deletions
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 2dc2e47..f8f2342 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -65,7 +65,7 @@ typedef struct Link {
*/
static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
- CONST char *name1, CONST char *name2, int flags);
+ const char *name1, const char *name2, int flags);
static Tcl_Obj * ObjValue(Link *linkPtr);
static int GetInvalidIntFromObj(Tcl_Obj *objPtr,
int *intPtr);
@@ -106,7 +106,7 @@ static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
int
Tcl_LinkVar(
Tcl_Interp *interp, /* Interpreter in which varName exists. */
- CONST char *varName, /* Name of a global variable in interp. */
+ const char *varName, /* Name of a global variable in interp. */
char *addr, /* Address of a C variable to be linked to
* varName. */
int type) /* Type of C variable: TCL_LINK_INT, etc. Also
@@ -116,15 +116,15 @@ Tcl_LinkVar(
Link *linkPtr;
int code;
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, (ClientData) NULL);
+ 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 = (Link *) ckalloc(sizeof(Link));
+ linkPtr = ckalloc(sizeof(Link));
linkPtr->interp = interp;
linkPtr->varName = Tcl_NewStringObj(varName, -1);
Tcl_IncrRefCount(linkPtr->varName);
@@ -139,15 +139,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,
- (ClientData) 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;
}
@@ -173,20 +173,19 @@ Tcl_LinkVar(
void
Tcl_UnlinkVar(
Tcl_Interp *interp, /* Interpreter containing variable to unlink */
- CONST char *varName) /* Global variable in interp to unlink. */
+ const char *varName) /* Global variable in interp to unlink. */
{
- Link *linkPtr;
+ Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, (ClientData) 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, (ClientData) linkPtr);
+ LinkTraceProc, linkPtr);
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
}
/*
@@ -211,13 +210,12 @@ Tcl_UnlinkVar(
void
Tcl_UpdateLinkedVar(
Tcl_Interp *interp, /* Interpreter containing variable. */
- CONST char *varName) /* Name of global variable that is linked. */
+ const char *varName) /* Name of global variable that is linked. */
{
- Link *linkPtr;
+ Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
int savedFlag;
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, (ClientData) NULL);
if (linkPtr == NULL) {
return;
}
@@ -228,8 +226,8 @@ Tcl_UpdateLinkedVar(
/*
* Callback may have unlinked the variable. [Bug 1740631]
*/
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, (ClientData) NULL);
+ linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
if (linkPtr != NULL) {
linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
}
@@ -260,13 +258,13 @@ static char *
LinkTraceProc(
ClientData clientData, /* Contains information about the link. */
Tcl_Interp *interp, /* Interpreter containing Tcl variable. */
- CONST char *name1, /* First part of variable name. */
- CONST char *name2, /* Second part of variable name. */
+ const char *name1, /* First part of variable name. */
+ const char *name2, /* Second part of variable name. */
int flags) /* Miscellaneous additional information. */
{
- Link *linkPtr = (Link *) clientData;
+ Link *linkPtr = clientData;
int changed, valueLength;
- CONST char *value;
+ const char *value;
char **pp;
Tcl_Obj *valueObj;
int valueInt;
@@ -281,13 +279,13 @@ 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, (ClientData) linkPtr);
+ |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
}
return NULL;
}
@@ -350,7 +348,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),
@@ -371,7 +369,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) {
@@ -379,7 +377,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) {
@@ -390,7 +388,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;
@@ -403,7 +401,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";
}
linkPtr->lastValue.w = (Tcl_WideInt) valueInt;
}
@@ -420,7 +418,7 @@ LinkTraceProc(
!= TCL_OK) {
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
}
@@ -435,7 +433,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;
@@ -447,7 +445,7 @@ LinkTraceProc(
!= TCL_OK) {
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;
@@ -461,7 +459,7 @@ LinkTraceProc(
!= TCL_OK) {
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;
@@ -475,7 +473,7 @@ LinkTraceProc(
!= TCL_OK) {
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;
@@ -489,7 +487,7 @@ LinkTraceProc(
!= TCL_OK) {
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;
@@ -503,7 +501,7 @@ LinkTraceProc(
!= TCL_OK) {
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)valueInt;
} else {
@@ -519,7 +517,7 @@ LinkTraceProc(
!= TCL_OK) {
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)valueInt;
} else {
@@ -535,7 +533,7 @@ LinkTraceProc(
!= TCL_OK) {
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)valueInt;
} else {
@@ -553,7 +551,7 @@ LinkTraceProc(
!= 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)valueInt;
} else {
@@ -569,7 +567,7 @@ LinkTraceProc(
!= TCL_OK) {
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;
@@ -577,7 +575,7 @@ LinkTraceProc(
break;
case TCL_LINK_STRING:
- value = Tcl_GetStringFromObj(valueObj, &valueLength);
+ value = TclGetStringFromObj(valueObj, &valueLength);
valueLength++;
pp = (char **) linkPtr->addr;
@@ -586,7 +584,7 @@ LinkTraceProc(
break;
default:
- return "internal error: bad linked variable type";
+ return (char *) "internal error: bad linked variable type";
}
return NULL;
}
@@ -724,23 +722,22 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
/*
* This function checks for integer representations, which are valid
* when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are "", "+", "-", "0x", "0b" and "0o"
+ * contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o"
* (upperand lowercase). See bug [39f6304c2e].
*/
int
GetInvalidIntFromObj(Tcl_Obj *objPtr,
int *intPtr)
{
- int length;
- const char *str = TclGetStringFromObj(objPtr, &length);
+ const char *str = TclGetString(objPtr);
- if ((length == 1) && strchr("+-", str[0])) {
- *intPtr = (str[0] == '+');
- return TCL_OK;
- } else if ((length == 0) ||
- ((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
+ if ((objPtr->length == 0) ||
+ ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
*intPtr = 0;
return TCL_OK;
+ } else if ((objPtr->length == 1) && strchr("+-", str[0])) {
+ *intPtr = (str[0] == '+');
+ return TCL_OK;
}
return TCL_ERROR;
}
@@ -748,25 +745,28 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr,
/*
* This function checks for double representations, which are valid
* when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are ".", "+", "-", "0x", "0b" and "0o"
+ * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
* (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
*/
int
GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
double *doublePtr)
{
- int intValue, result;
+ int intValue;
- if ((objPtr->typePtr == &invalidRealType) ||
- (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK)) {
- *doublePtr = objPtr->internalRep.doubleValue;
- return TCL_OK;
+ if (objPtr->typePtr == &invalidRealType) {
+ goto gotdouble;
}
- result = GetInvalidIntFromObj(objPtr, &intValue);
- if (result == TCL_OK) {
+ if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
*doublePtr = (double) intValue;
+ return TCL_OK;
}
- return result;
+ if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
+ gotdouble:
+ *doublePtr = objPtr->internalRep.doubleValue;
+ return TCL_OK;
+ }
+ return TCL_ERROR;
}
/*
generated by cgit v0.12 at 2024-07-05 07:47:33 (GMT)