summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/GetInt.34
-rw-r--r--doc/LinkVar.316
-rw-r--r--generic/tcl.h27
-rw-r--r--generic/tclGet.c2
-rw-r--r--generic/tclHistory.c5
-rw-r--r--generic/tclLink.c88
-rw-r--r--generic/tclObj.c23
-rw-r--r--tests/link.test8
8 files changed, 100 insertions, 73 deletions
diff --git a/doc/GetInt.3 b/doc/GetInt.3
index 5a3304a..99dd030 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -89,10 +89,10 @@ as a decimal point is not supported nor should any other sort of
inter-digit separator be present.
.PP
\fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean
-value. If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR,
+value. If \fIsrc\fR is any of \fB0\fR, \fB-\fR, \fBfalse\fR,
\fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero
value at \fI*boolPtr\fR.
-If \fIsrc\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR,
+If \fIsrc\fR is any of \fB1\fR, \fB+\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR,
then 1 is stored at \fI*boolPtr\fR.
Any of these values may be abbreviated, and upper-case spellings
are also acceptable.
diff --git a/doc/LinkVar.3 b/doc/LinkVar.3
index c80d30d..5695a42 100644
--- a/doc/LinkVar.3
+++ b/doc/LinkVar.3
@@ -174,6 +174,22 @@ rejected with Tcl errors. Incomplete integer representations (like
the empty string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
+\fBTCL_LINK_SIZE\fR
+The C variable is of type \fBsize_t\fR.
+Any value written into the Tcl variable must have a proper unsigned
+integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
+platform's defined range for the \fBsize_t\fR type; attempts to
+write non-integer values (or values outside the range) into
+\fIvarName\fR will be rejected with Tcl errors.
+.TP
+\fBTCL_LINK_SSIZE\fR
+The C variable is of type \fBssize_t\fR.
+Any value written into the Tcl variable must have a proper
+integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
+platform's defined range for the \fBssize_t\fR type; attempts to
+write non-integer values (or values outside the range) into
+\fIvarName\fR will be rejected with Tcl errors.
+.TP
\fBTCL_LINK_BOOLEAN\fR
The C variable is of type \fBint\fR.
If its value is zero then it will read from Tcl as
diff --git a/generic/tcl.h b/generic/tcl.h
index c0cee27..da22190 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1139,7 +1139,11 @@ typedef struct Tcl_DString {
#define TCL_LINK_INT 1
#define TCL_LINK_DOUBLE 2
-#define TCL_LINK_BOOLEAN 3
+#ifdef TCL_NO_DEPRECATED
+# define TCL_LINK_BOOLEAN TCL_LINK_INT
+#else
+# define TCL_LINK_BOOLEAN 3
+#endif
#define TCL_LINK_STRING 4
#define TCL_LINK_WIDE_INT 5
#define TCL_LINK_CHAR 6
@@ -1147,10 +1151,27 @@ typedef struct Tcl_DString {
#define TCL_LINK_SHORT 8
#define TCL_LINK_USHORT 9
#define TCL_LINK_UINT 10
-#define TCL_LINK_LONG 11
-#define TCL_LINK_ULONG 12
+#define TCL_LINK_LONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT)
+#define TCL_LINK_ULONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
#define TCL_LINK_FLOAT 13
#define TCL_LINK_WIDE_UINT 14
+#define TCL_LINK_SIZE ((sizeof(size_t) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
+#define TCL_LINK_SSIZE ((sizeof(size_t) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT)
+
+/* The following defines assume the <stdint.h> types */
+#define TCL_LINK_INT8 TCL_LINK_CHAR
+#define TCL_LINK_UINT8 TCL_LINK_UCHAR
+#define TCL_LINK_INT16 TCL_LINK_SHORT
+#define TCL_LINK_UINT16 TCL_LINK_USHORT
+#define TCL_LINK_INT32 TCL_LINK_INT
+#define TCL_LINK_UINT32 TCL_LINK_UINT
+#define TCL_LINK_INT64 TCL_LINK_WIDE_INT
+#define TCL_LINK_UINT64 TCL_LINK_WIDE_UINT
+#define TCL_LINK_INTMAX TCL_LINK_WIDE_INT
+#define TCL_LINK_UINTMAX TCL_LINK_WIDE_UINT
+#define TCL_LINK_INTPTR TCL_LINK_SSIZE
+#define TCL_LINK_UINTPTR TCL_LINK_SIZE
+
#define TCL_LINK_READ_ONLY 0x80
/*
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 97e8c7b..8898a0f 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -125,7 +125,7 @@ int
Tcl_GetBoolean(
Tcl_Interp *interp, /* Interpreter used for error reporting. */
const char *src, /* String containing one of the boolean values
- * 1, 0, true, false, yes, no, on, off. */
+ * 1, 0, +, -, true, false, yes, no, on, off. */
int *boolPtr) /* Place to store converted result, which will
* be 0 or 1. */
{
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index b08e352..47806d4 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -62,15 +62,14 @@ Tcl_RecordAndEval(
* instead of Tcl_Eval. */
{
register Tcl_Obj *cmdPtr;
- int length = strlen(cmd);
int result;
- if (length > 0) {
+ if (cmd[0]) {
/*
* Call Tcl_RecordAndEvalObj to do the actual work.
*/
- cmdPtr = Tcl_NewStringObj(cmd, length);
+ cmdPtr = Tcl_NewStringObj(cmd, -1);
Tcl_IncrRefCount(cmdPtr);
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 1507804..9a39139 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -36,8 +36,6 @@ typedef struct Link {
unsigned int ui;
short s;
unsigned short us;
- long l;
- unsigned long ul;
Tcl_WideInt w;
Tcl_WideUInt uw;
float f;
@@ -59,6 +57,14 @@ typedef struct Link {
#define LINK_READ_ONLY 1
#define LINK_BEING_UPDATED 2
+#ifndef TCL_NO_DEPRECATED
+
+/* Within tclLink.c, we need legacy values for those two. Can be removed in Tcl 9 */
+#undef TCL_LINK_LONG
+#define TCL_LINK_LONG 11
+#undef TCL_LINK_ULONG
+#define TCL_LINK_ULONG 12
+#endif /* TCL_NO_DEPRECATED */
/*
* Forward references to functions defined later in this file:
@@ -129,6 +135,13 @@ Tcl_LinkVar(
Tcl_IncrRefCount(linkPtr->varName);
linkPtr->addr = addr;
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
+#ifndef TCL_NO_DEPRECATED
+ if (linkPtr->type == TCL_LINK_LONG) {
+ linkPtr->type = ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT);
+ } else if (linkPtr->type == TCL_LINK_ULONG) {
+ linkPtr->type = ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT);
+ }
+#endif /* TCL_NO_DEPRECATED */
if (type & TCL_LINK_READ_ONLY) {
linkPtr->flags = LINK_READ_ONLY;
} else {
@@ -308,9 +321,11 @@ LinkTraceProc(
if (flags & TCL_TRACE_READS) {
switch (linkPtr->type) {
case TCL_LINK_INT:
+#ifndef TCL_NO_DEPRECATED
case TCL_LINK_BOOLEAN:
changed = (LinkedVar(int) != linkPtr->lastValue.i);
break;
+#endif
case TCL_LINK_DOUBLE:
changed = (LinkedVar(double) != linkPtr->lastValue.d);
break;
@@ -335,12 +350,6 @@ LinkTraceProc(
case TCL_LINK_UINT:
changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
break;
- case TCL_LINK_LONG:
- changed = (LinkedVar(long) != linkPtr->lastValue.l);
- break;
- case TCL_LINK_ULONG:
- changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
- break;
case TCL_LINK_FLOAT:
changed = (LinkedVar(float) != linkPtr->lastValue.f);
break;
@@ -386,7 +395,7 @@ LinkTraceProc(
&& GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have integer value";
+ return (char *) "variable must have integer or boolean value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
@@ -396,7 +405,7 @@ LinkTraceProc(
&& GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have integer value";
+ return (char *) "variable must have integer or boolean value";
}
LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
break;
@@ -419,6 +428,7 @@ LinkTraceProc(
LinkedVar(double) = linkPtr->lastValue.d;
break;
+#ifndef TCL_NO_DEPRECATED
case TCL_LINK_BOOLEAN:
if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -427,6 +437,7 @@ LinkTraceProc(
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
+#endif
case TCL_LINK_CHAR:
if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
@@ -434,7 +445,7 @@ LinkTraceProc(
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have char value";
+ return (char *) "variable must have char or boolean value";
}
LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt;
break;
@@ -445,7 +456,7 @@ LinkTraceProc(
|| valueInt < 0 || valueInt > UCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned char value";
+ return (char *) "variable must have unsigned char or boolean value";
}
LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt;
break;
@@ -456,7 +467,7 @@ LinkTraceProc(
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have short value";
+ return (char *) "variable must have short or boolean value";
}
LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt;
break;
@@ -467,7 +478,7 @@ LinkTraceProc(
|| valueInt < 0 || valueInt > USHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned short value";
+ return (char *) "variable must have unsigned short or boolean value";
}
LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt;
break;
@@ -478,33 +489,11 @@ LinkTraceProc(
|| valueWide < 0 || valueWide > UINT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned int value";
+ return (char *) "variable must have unsigned int or boolean value";
}
LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide;
break;
- case TCL_LINK_LONG:
- if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
- && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
- || valueWide < LONG_MIN || valueWide > LONG_MAX) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have long value";
- }
- LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide;
- break;
-
- case TCL_LINK_ULONG:
- if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
- && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
- || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned long value";
- }
- LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide;
- break;
-
case TCL_LINK_WIDE_UINT:
/*
* FIXME: represent as a bignum.
@@ -513,7 +502,7 @@ LinkTraceProc(
&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned wide int value";
+ return (char *) "variable must have unsigned wide int or boolean value";
}
LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
break;
@@ -579,9 +568,11 @@ ObjValue(
case TCL_LINK_DOUBLE:
linkPtr->lastValue.d = LinkedVar(double);
return Tcl_NewDoubleObj(linkPtr->lastValue.d);
+#ifndef TCL_NO_DEPRECATED
case TCL_LINK_BOOLEAN:
linkPtr->lastValue.i = LinkedVar(int);
return Tcl_NewBooleanObj(linkPtr->lastValue.i);
+#endif
case TCL_LINK_CHAR:
linkPtr->lastValue.c = LinkedVar(char);
return Tcl_NewIntObj(linkPtr->lastValue.c);
@@ -597,12 +588,6 @@ ObjValue(
case TCL_LINK_UINT:
linkPtr->lastValue.ui = LinkedVar(unsigned int);
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
- case TCL_LINK_LONG:
- linkPtr->lastValue.l = LinkedVar(long);
- return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
- case TCL_LINK_ULONG:
- linkPtr->lastValue.ul = LinkedVar(unsigned long);
- return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
case TCL_LINK_FLOAT:
linkPtr->lastValue.f = LinkedVar(float);
return Tcl_NewDoubleObj(linkPtr->lastValue.f);
@@ -674,10 +659,10 @@ 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"
- * (upperand lowercase). See bug [39f6304c2e].
+ * This function checks for integer or boolean representations,
+ * which are valid when linking with C variables, but which are
+ * invalid in other contexts in Tcl. Handled are "", "0x", "0b"
+ * and "0o" (upperand lowercase). See bug [39f6304c2e].
*/
int
GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
@@ -688,11 +673,8 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
((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;
+ return Tcl_GetBooleanFromObj(NULL, objPtr, intPtr);
}
int
@@ -710,7 +692,7 @@ GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr)
/*
* 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 booleans, "", ".", "0x", "0b" and "0o"
* (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
*/
int
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 1abbb31..f81527b 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2029,6 +2029,18 @@ ParseBoolean(
goto numericBoolean;
}
return TCL_ERROR;
+ case '-':
+ if (length == 1) {
+ newBool = 0;
+ goto goodBoolean;
+ }
+ return TCL_ERROR;
+ case '+':
+ if (length == 1) {
+ newBool = 1;
+ goto goodBoolean;
+ }
+ return TCL_ERROR;
}
/*
@@ -2082,15 +2094,12 @@ ParseBoolean(
}
return TCL_ERROR;
case 'o':
- if (length < 2) {
- return TCL_ERROR;
- }
- if (strncmp(lowerCase, "on", length) == 0) {
- newBool = 1;
- goto goodBoolean;
- } else if (strncmp(lowerCase, "off", length) == 0) {
+ if (strncmp(lowerCase, "off", (size_t) length) == 0) {
newBool = 0;
goto goodBoolean;
+ } else if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+ newBool = 1;
+ goto goodBoolean;
}
return TCL_ERROR;
default:
diff --git a/tests/link.test b/tests/link.test
index dda7d6b..a8d686d 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -67,7 +67,7 @@ test link-2.2 {writing bad values into variables} -setup {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set int 09a} msg] $msg $int
-} -result {1 {can't set "int": variable must have integer value} 43}
+} -result {1 {can't set "int": variable must have integer or boolean value} 43}
test link-2.3 {writing bad values into variables} -setup {
testlink delete
} -constraints {testlink} -body {
@@ -88,7 +88,7 @@ test link-2.5 {writing bad values into variables} -setup {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set wide gorp} msg] $msg $bool
-} -result {1 {can't set "wide": variable must have integer value} 1}
+} -result {1 {can't set "wide": variable must have integer or boolean value} 1}
test link-2.6 {writing C variables from Tcl} -constraints {testlink} -setup {
testlink delete
} -body {
@@ -309,7 +309,7 @@ test link-7.4 {access to linked variables via upvar} -setup {
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $int
-} -result {1 {can't set "y": variable must have integer value} -4}
+} -result {1 {can't set "y": variable must have integer or boolean value} -4}
test link-7.5 {access to linked variables via upvar} -setup {
testlink delete
} -constraints {testlink} -body {
@@ -342,7 +342,7 @@ test link-7.7 {access to linked variables via upvar} -setup {
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $wide
-} -result {1 {can't set "y": variable must have integer value} 778899}
+} -result {1 {can't set "y": variable must have integer or boolean value} 778899}
test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
proc x args {
generated by cgit v0.12 at 2025-06-01 06:22:56 (GMT)