diff options
Diffstat (limited to 'generic/tclLink.c')
-rw-r--r-- | generic/tclLink.c | 130 |
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; } /* |