From c9c1696a2d8c2c3d094e54b96defd269c0687692 Mon Sep 17 00:00:00 2001 From: bch Date: Sun, 6 Dec 2020 18:39:21 +0000 Subject: allow NULL for indexPtr to say "am not interested in index, just membership in set of possibilities" for Tcl_GetIndexFromObj() --- doc/GetIndex.3 | 8 ++++---- generic/tclIndexObj.c | 31 ++++++++++++++++++------------- 2 files changed, 22 insertions(+), 17 deletions(-) diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index 8591c56..111ae62 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -56,8 +56,8 @@ OR-ed combination of bits providing additional information for operation. The only bits that are currently defined are \fBTCL_EXACT\fR and \fBTCL_INDEX_TEMP_TABLE\fR. .AP int *indexPtr out -The index of the string in \fItablePtr\fR that matches the value of -\fIobjPtr\fR is returned here. +If not NULL, the index of the string in \fItablePtr\fR that matches +the value of \fIobjPtr\fR is returned here. .BE .SH DESCRIPTION .PP @@ -70,8 +70,8 @@ the strings in \fItablePtr\fR to find a match. A match occurs if \fItablePtr\fR, or if it is a non-empty unique abbreviation for exactly one of the strings in \fItablePtr\fR and the \fBTCL_EXACT\fR flag was not specified; in either case -the index of the matching entry is stored at \fI*indexPtr\fR -and \fBTCL_OK\fR is returned. +\fBTCL_OK\fR is returned. If \fI*indexPtr\fR is not NULL the index +of the matching entry is stored there. .PP If there is no matching entry, \fBTCL_ERROR\fR is returned and an error message is left in \fIinterp\fR's diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 89582b7..c3092c9 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -166,11 +166,12 @@ GetIndexFromObjList( * Results: * If the value of objPtr is identical to or a unique abbreviation for * one of the entries in tablePtr, then the return value is TCL_OK and - * the index of the matching entry is stored at *indexPtr. If there isn't - * a proper match, then TCL_ERROR is returned and an error message is - * left in interp's result (unless interp is NULL). The msg argument is - * used in the error message; for example, if msg has the value "option" - * then the error message will say something like 'bad option "foo": must + * the index of the matching entry is stored at *indexPtr + * (unless indexPtr is NULL). If there isn't a proper match, then + * TCL_ERROR is returned and an error message is left in interp's + * result (unless interp is NULL). The msg argument is used in the + * error message; for example, if msg has the value "option" then + * the error message will say something like 'bad option "foo": must * be ...' * * Side effects: @@ -212,15 +213,17 @@ Tcl_GetIndexFromObjStruct( */ if (!(flags & TCL_INDEX_TEMP_TABLE)) { - irPtr = TclFetchIntRep(objPtr, &indexType); - if (irPtr) { - indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; - if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { - *indexPtr = indexRep->index; - return TCL_OK; + irPtr = TclFetchIntRep (objPtr, &indexType); + if (irPtr) { + indexRep = (IndexRep *) irPtr->twoPtrValue.ptr1; + if (indexRep->tablePtr == tablePtr && indexRep->offset == offset) { + if (indexPtr != NULL) { + *indexPtr = indexRep->index; + } + return TCL_OK; + } } } - } /* * Lookup the value of the object in the table. Accept unique @@ -291,7 +294,9 @@ Tcl_GetIndexFromObjStruct( indexRep->index = index; } - *indexPtr = index; + if(indexPtr != NULL) { + *indexPtr = index; + } return TCL_OK; error: -- cgit v0.12 From 902547c2b25bc92a576879d666aaf79c6e635aab Mon Sep 17 00:00:00 2001 From: bch Date: Sun, 6 Dec 2020 20:57:32 +0000 Subject: comment grammar --- generic/tcl.decls | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index dc57324..eacfb28 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -24,8 +24,8 @@ hooks {tclPlat tclInt tclIntPlat} scspec EXTERN # Declare each of the functions in the public Tcl interface. Note that -# the an index should never be reused for a different function in order -# to preserve backwards compatibility. +# in order to preserve backwards compatibility an index should +# never be reused for a different function declare 0 { int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, -- cgit v0.12 From 933584b14430d2c9df09702eb344ff261bd40776 Mon Sep 17 00:00:00 2001 From: bch Date: Sun, 6 Dec 2020 20:58:21 +0000 Subject: Period. --- generic/tcl.decls | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index eacfb28..4362c4c 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -25,7 +25,7 @@ scspec EXTERN # Declare each of the functions in the public Tcl interface. Note that # in order to preserve backwards compatibility an index should -# never be reused for a different function +# never be reused for a different function. declare 0 { int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, -- cgit v0.12 From 5d92b3dc112a0525e4c00cba1b4b9e9b5c29425d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Dec 2021 14:46:41 +0000 Subject: TIP #613: New INDEX_NULL_OK flag for Tcl_GetIndexFromObj*() --- doc/GetIndex.3 | 6 ++++-- generic/tcl.h | 3 +++ generic/tclIndexObj.c | 20 +++++++++++++++----- generic/tclTest.c | 17 ++++++++++------- tests/indexObj.test | 4 ++++ 5 files changed, 36 insertions(+), 14 deletions(-) diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index a788848..1af1663 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -54,7 +54,7 @@ Null-terminated string describing what is being looked up, such as .AP int flags in OR-ed combination of bits providing additional information for operation. The only bits that are currently defined are \fBTCL_EXACT\fR -and \fBTCL_INDEX_TEMP_TABLE\fR. +, \fBTCL_INDEX_TEMP_TABLE\fR, and \fBTCL_INDEX_NULL_OK\fR. .AP int *indexPtr out The index of the string in \fItablePtr\fR that matches the value of \fIobjPtr\fR is returned here. @@ -91,7 +91,9 @@ operation. Note: \fBTcl_GetIndexFromObj\fR assumes that the entries in \fItablePtr\fR are static: they must not change between invocations. This caching mechanism can be disallowed by specifying the \fBTCL_INDEX_TEMP_TABLE\fR flag. -If the value of \fIobjPtr\fR is the empty string, +If the \fBTCL_INDEX_NULL_OK\fR flag was specified, objPtr is allowed +to be NULL or the empty string. The resulting index is -1. +Otherwise, if the value of \fIobjPtr\fR is the empty string, \fBTcl_GetIndexFromObj\fR will treat it as a non-matching value and return \fBTCL_ERROR\fR. .PP diff --git a/generic/tcl.h b/generic/tcl.h index 346b79c..b82cf0a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -979,10 +979,13 @@ typedef struct Tcl_DString { * TCL_EXACT disallows abbreviated strings. * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is * a table that will not live long enough to make it worthwhile. + * TCL_INDEX_NULL_OK allows the empty string or NULL to return TCL_OK. + * The returned value will be -1; */ #define TCL_EXACT 1 #define TCL_INDEX_TEMP_TABLE 2 +#define TCL_INDEX_NULL_OK 4 /* *---------------------------------------------------------------------------- diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index c2812ea..e9c453a 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -261,7 +261,7 @@ Tcl_GetIndexFromObjStruct( int offset, /* The number of bytes between entries */ const char *msg, /* Identifying word to use in error * messages. */ - int flags, /* 0 or TCL_EXACT */ + int flags, /* 0, TCL_EXACT, TCL_INDEX_TEMP_TABLE or TCL_INDEX_NULL_OK */ int *indexPtr) /* Place to store resulting integer index. */ { int index, idx, numAbbrev; @@ -280,7 +280,10 @@ Tcl_GetIndexFromObjStruct( * See if there is a valid cached result from a previous lookup. */ - if (!(flags & TCL_INDEX_TEMP_TABLE)) { + if (!objPtr && (flags & TCL_INDEX_NULL_OK)) { + *indexPtr = -1; + return TCL_OK; + } else if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) { irPtr = TclFetchInternalRep(objPtr, &indexType); if (irPtr) { indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; @@ -296,10 +299,14 @@ Tcl_GetIndexFromObjStruct( * abbreviations unless TCL_EXACT is set in flags. */ - key = TclGetString(objPtr); + key = objPtr ? TclGetString(objPtr) : ""; index = -1; numAbbrev = 0; + if (!*key && (flags & TCL_INDEX_NULL_OK)) { + *indexPtr = -1; + return TCL_OK; + } /* * Scan the table looking for one of: * - An exact match (always preferred) @@ -344,7 +351,7 @@ Tcl_GetIndexFromObjStruct( * operation. */ - if (!(flags & TCL_INDEX_TEMP_TABLE)) { + if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) { irPtr = TclFetchInternalRep(objPtr, &indexType); if (irPtr) { indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; @@ -386,7 +393,7 @@ Tcl_GetIndexFromObjStruct( *entryPtr, NULL); entryPtr = NEXT_ENTRY(entryPtr, offset); while (*entryPtr != NULL) { - if (*NEXT_ENTRY(entryPtr, offset) == NULL) { + if ((*NEXT_ENTRY(entryPtr, offset) == NULL) && !(flags & TCL_INDEX_NULL_OK)) { Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""), " or ", *entryPtr, NULL); } else if (**entryPtr) { @@ -395,6 +402,9 @@ Tcl_GetIndexFromObjStruct( } entryPtr = NEXT_ENTRY(entryPtr, offset); } + if ((flags & TCL_INDEX_NULL_OK)) { + Tcl_AppendStringsToObj(resultPtr, ", or \"\"", NULL); + } } Tcl_SetObjResult(interp, resultPtr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); diff --git a/generic/tclTest.c b/generic/tclTest.c index 46a1459..e18283d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6285,17 +6285,20 @@ TestGetIndexFromObjStructObjCmd( const char *const ary[] = { "a", "b", "c", "d", "e", "f", NULL, NULL }; - int idx,target; + int idx,target, flags = 0; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue"); + if (objc != 3 && objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue ?flags?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *), - "dummy", 0, &idx) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) { return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) { + if ((objc > 3) && (Tcl_GetIntFromObj(interp, objv[3], &flags) != TCL_OK)) { + return TCL_ERROR; + } + if (Tcl_GetIndexFromObjStruct(interp, (Tcl_GetString(objv[1])[0] ? objv[1] : NULL), ary, 2*sizeof(char *), + "dummy", flags, &idx) != TCL_OK) { return TCL_ERROR; } if (idx != target) { @@ -6307,7 +6310,7 @@ TestGetIndexFromObjStructObjCmd( Tcl_AppendResult(interp, " when ", buffer, " expected", NULL); return TCL_ERROR; } - Tcl_WrongNumArgs(interp, 3, objv, NULL); + Tcl_WrongNumArgs(interp, objc, objv, NULL); return TCL_OK; } diff --git a/tests/indexObj.test b/tests/indexObj.test index bd6a2c2..c615e15 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -131,6 +131,10 @@ test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj { testgetindexfromobjstruct $x 1 testgetindexfromobjstruct $x 1 } "wrong # args: should be \"testgetindexfromobjstruct c 1\"" +test indexObj-6.5 {Tcl_GetIndexFromObjStruct} testindexobj { + set x "" + testgetindexfromobjstruct $x -1 4 +} "wrong # args: should be \"testgetindexfromobjstruct {} -1 4\"" test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs { testparseargs -- cgit v0.12 From 48cff4f47c0343d658ad32b1763b8461e9c71114 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Dec 2021 14:10:05 +0000 Subject: formatting --- generic/tclTest.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 1c9e605..7b97a65 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6286,7 +6286,7 @@ TestGetIndexFromObjStructObjCmd( "a", "b", "c", "d", "ee", "ff", NULL, NULL }; int target, flags = 0; - signed char idx[8]; + signed char idx[8]; if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue ?flags?"); @@ -6300,15 +6300,15 @@ TestGetIndexFromObjStructObjCmd( } memset(idx, 85, sizeof(idx)); if (Tcl_GetIndexFromObjStruct(interp, (Tcl_GetString(objv[1])[0] ? objv[1] : NULL), ary, 2*sizeof(char *), - "dummy", flags, &idx[0]) != TCL_OK) { + "dummy", flags, &idx[1]) != TCL_OK) { return TCL_ERROR; } - if (idx[1] != 85) { - Tcl_AppendResult(interp, "Tcl_GetIndexFromObjStruct overwrites size", NULL); + if (idx[0] != 85 || idx[2] != 85) { + Tcl_AppendResult(interp, "Tcl_GetIndexFromObjStruct overwrites bytes near index variable", NULL); return TCL_ERROR; - } else if (idx[0] != target) { + } else if (idx[1] != target) { char buffer[64]; - sprintf(buffer, "%d", idx[0]); + sprintf(buffer, "%d", idx[1]); Tcl_AppendResult(interp, "index value comparison failed: got ", buffer, NULL); sprintf(buffer, "%d", target); -- cgit v0.12 From 8fd0500bc8b2821f46d079ebc6b19bb39a25152e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 17 Feb 2022 09:30:37 +0000 Subject: Addendum to [7deeddb36]: Use WIDE_MIN/WIDE_MAX in more places --- generic/tclObj.c | 2 +- generic/tclScan.c | 35 +++++++++++++++++++---------------- generic/tclStrToD.c | 11 +++++------ 3 files changed, 25 insertions(+), 23 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index f7bb44c..9afcedb 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3569,7 +3569,7 @@ Tcl_SetBignumObj( while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } - if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) { + if (value > ((UWIDE_MAX >> 1) + bignumValue->sign)) { goto tooLargeForWide; } if (bignumValue->sign) { diff --git a/generic/tclScan.c b/generic/tclScan.c index f6ff7a9..f37f596 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -28,15 +28,17 @@ * character set. */ -typedef struct CharSet { +typedef struct { + Tcl_UniChar start; + Tcl_UniChar end; +} Range; + +typedef struct { int exclude; /* 1 if this is an exclusion set. */ int nchars; Tcl_UniChar *chars; int nranges; - struct Range { - Tcl_UniChar start; - Tcl_UniChar end; - } *ranges; + Range *ranges; } CharSet; /* @@ -101,9 +103,9 @@ BuildCharSet( end += TclUtfToUniChar(end, &ch); } - cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); + cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); if (nranges > 0) { - cset->ranges = ckalloc(sizeof(struct Range) * nranges); + cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges); } else { cset->ranges = NULL; } @@ -259,12 +261,12 @@ ValidateFormat( char *end; Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; - int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); - char buf[TCL_UTF_MAX+1] = ""; + int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int)); Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ + char buf[TCL_UTF_MAX+1] = ""; /* * Initialize an array that records the number of times a variable is @@ -483,7 +485,7 @@ ValidateFormat( } else { nspace += 16; /* formerly STATIC_LIST_SIZE */ } - nassign = TclStackRealloc(interp, nassign, + nassign = (int *)TclStackRealloc(interp, nassign, nspace * sizeof(int)); for (i = value; i < nspace; i++) { nassign[i] = 0; @@ -566,7 +568,6 @@ ValidateFormat( *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ScanObjCmd( ClientData dummy, /* Not used. */ @@ -585,6 +586,7 @@ Tcl_ScanObjCmd( Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; + (void)dummy; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, @@ -608,7 +610,7 @@ Tcl_ScanObjCmd( */ if (totalVars > 0) { - objs = ckalloc(sizeof(Tcl_Obj *) * totalVars); + objs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * totalVars); for (i = 0; i < totalVars; i++) { objs[i] = NULL; } @@ -895,7 +897,7 @@ Tcl_ScanObjCmd( /* * Scan an unsigned or signed integer. */ - objPtr = Tcl_NewLongObj(0); + TclNewIntObj(objPtr, 0); Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; @@ -921,9 +923,10 @@ Tcl_ScanObjCmd( } if (flags & SCAN_LONGER) { if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { - wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */ if (TclGetString(objPtr)[0] == '-') { - wideValue += 1U; /* WIDE_MAX + 1 = WIDE_MIN */ + wideValue = WIDE_MIN; + } else { + wideValue = WIDE_MAX; } } if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { @@ -950,7 +953,7 @@ Tcl_ScanObjCmd( Tcl_SetWideIntObj(objPtr, (unsigned long)value); #endif } else { - Tcl_SetLongObj(objPtr, value); + TclSetLongObj(objPtr, value); } } objs[objIndex++] = objPtr; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 1a1c2ac..61162d0 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -542,8 +542,7 @@ TclParseNumber( int shift = 0; /* Amount to shift when accumulating binary */ int explicitOctal = 0; -#define ALL_BITS (~(Tcl_WideUInt)0) -#define MOST_BITS (ALL_BITS >> 1) +#define MOST_BITS (UWIDE_MAX >> 1) /* * Initialize bytes to start of the object's string rep if the caller @@ -703,7 +702,7 @@ TclParseNumber( && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) || (octalSignificandWide > - (~(Tcl_WideUInt)0 >> shift)))) { + (UWIDE_MAX >> shift)))) { octalSignificandOverflow = 1; TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); @@ -829,7 +828,7 @@ TclParseNumber( if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || - significandWide > (~(Tcl_WideUInt)0 >> shift))) { + significandWide > (UWIDE_MAX >> shift))) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); @@ -881,7 +880,7 @@ TclParseNumber( if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || - significandWide > (~(Tcl_WideUInt)0 >> shift))) { + significandWide > (UWIDE_MAX >> shift))) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); @@ -1545,7 +1544,7 @@ AccumulateDecimalDigit( *wideRepPtr = digit; return 0; } else if (numZeros >= maxpow10_wide - || w > ((~(Tcl_WideUInt)0)-digit)/pow10_wide[numZeros+1]) { + || w > (UWIDE_MAX-digit)/pow10_wide[numZeros+1]) { /* * Wide multiplication will overflow. Expand the number to a * bignum and fall through into the bignum case. -- cgit v0.12