From 5f9e047cf5d7f3adca4154b75cf8f68325330af8 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 26 Apr 2022 12:03:22 +0000 Subject: added test illustrating bug [27520c9b17] --- tests/error.test | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/error.test b/tests/error.test index af07ed7..08bd00c 100644 --- a/tests/error.test +++ b/tests/error.test @@ -351,6 +351,13 @@ test error-9.4 {try (ok, non-empty result) with on handler} { test error-9.5 {try (ok, non-empty result) with on ok handler} { try { list a b c } on ok {} { list d e f } } {d e f} +test error-9.6 {try (compilation of simple finaly token only, bug [27520c9b17])} -body { + set b {}; set l {} + try {lappend l error} finally [lappend l set b] + list $l $b +} -cleanup { + unset -nocomplain b l +} -result {{set b error} {}} # simple try tests - "on" handler matching -- cgit v0.12 From 2ce077e7c8a82332c62a598756f2de7dffb17376 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 26 Apr 2022 12:03:41 +0000 Subject: fixes compilation of try-command [27520c9b17]: compile only if finaly token is simple --- generic/tclCompCmdsSZ.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 53bff6e..abaf7a7 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -2929,6 +2929,9 @@ TclCompileTryCmd( goto failedToCompile; } finallyToken = TokenAfter(tokenPtr); + if (finallyToken->type != TCL_TOKEN_SIMPLE_WORD) { + goto failedToCompile; + } } else { goto failedToCompile; } -- cgit v0.12 From 05b9aa05c1439506d60f983b5dc4e37ed339f02b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 Apr 2022 12:11:49 +0000 Subject: Missing macro's for Tcl_GetBytesFromObj() (TIP #568), only can handle size_t * this way --- generic/tclDecls.h | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 559d67c..c5f89b5 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3908,9 +3908,12 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_GetStringFromObj #undef Tcl_GetUnicodeFromObj #undef Tcl_GetByteArrayFromObj +#undef Tcl_GetBytesFromObj #if defined(USE_TCL_STUBS) #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tcl_GetStringFromObj(objPtr, (size_t *)(sizePtr))) +#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(sizePtr)) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(sizePtr)) : tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (size_t *)(sizePtr))) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ @@ -3920,8 +3923,10 @@ extern const TclStubs *tclStubsPtr; #else #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetStringFromObj)(objPtr, (int *)(sizePtr)) : (Tcl_GetStringFromObj)(objPtr, (size_t *)(sizePtr))) +#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)(sizePtr)) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetBytesFromObj)(NULL, objPtr, (int *)(sizePtr)) : Tcl_GetBytesFromObj(NULL, objPtr, (size_t *)(sizePtr))) + (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetBytesFromObj)(NULL, objPtr, (int *)(sizePtr)) : (Tcl_GetBytesFromObj)(NULL, objPtr, (size_t *)(sizePtr))) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetUnicodeFromObj)(objPtr, (int *)(sizePtr)) : Tcl_GetUnicodeFromObj(objPtr, (size_t *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ -- cgit v0.12 From 257691ef7309a95aa418da8017492f3c4c223fd6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 Apr 2022 12:22:51 +0000 Subject: Tcl_GetIndexFromObjStruct -> Tcl_GetIndexFromObj. Don't use braces around (Tcl_GetBytesFromObj) --- generic/tclExecute.c | 2 +- generic/tclIO.c | 4 ++-- generic/tclStringObj.c | 6 +++--- generic/tclTimer.c | 4 ++-- generic/tclZipfs.c | 9 ++++----- generic/tclZlib.c | 18 +++++++++--------- 6 files changed, 21 insertions(+), 22 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 42e8008..23c3ef5 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5113,7 +5113,7 @@ TEBCresume( TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( - (Tcl_GetBytesFromObj)(NULL, valuePtr, NULL)+index, 1); + Tcl_GetBytesFromObj(NULL, valuePtr, (size_t *)NULL)+index, 1); } else if (valuePtr->bytes && slength == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); diff --git a/generic/tclIO.c b/generic/tclIO.c index 57e1a66..4cf6a7e 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4573,7 +4573,7 @@ Tcl_GetsObj( if ((statePtr->encoding == NULL) && ((statePtr->inputTranslation == TCL_TRANSLATE_LF) || (statePtr->inputTranslation == TCL_TRANSLATE_CR)) - && (Tcl_GetBytesFromObj)(NULL, objPtr, NULL) != NULL) { + && Tcl_GetBytesFromObj(NULL, objPtr, (size_t *)NULL) != NULL) { return TclGetsObjBinary(chan, objPtr); } @@ -5843,7 +5843,7 @@ DoReadChars( && (statePtr->inEofChar == '\0'); if (appendFlag) { - if (binaryMode && (NULL == Tcl_GetBytesFromObj(NULL, objPtr, NULL))) { + if (binaryMode && (NULL == Tcl_GetBytesFromObj(NULL, objPtr, (size_t *)NULL))) { binaryMode = 0; } } else { diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 107640b..c5e018f 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1460,7 +1460,7 @@ Tcl_AppendObjToObj( */ TclAppendBytesToByteArray(objPtr, - (Tcl_GetBytesFromObj)(NULL, appendObjPtr, NULL), lengthSrc); + Tcl_GetBytesFromObj(NULL, appendObjPtr, (size_t *)NULL), lengthSrc); return; } @@ -2975,7 +2975,7 @@ TclStringRepeat( done *= 2; } TclAppendBytesToByteArray(objResultPtr, - (Tcl_GetBytesFromObj)(NULL, objResultPtr, NULL), + Tcl_GetBytesFromObj(NULL, objResultPtr, (size_t *)NULL), (count - done) * length); } else if (unichar) { /* @@ -3852,7 +3852,7 @@ TclStringReverse( if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); } - ReverseBytes((Tcl_GetBytesFromObj)(NULL, objPtr, NULL), from, numBytes); + ReverseBytes(Tcl_GetBytesFromObj(NULL, objPtr, (size_t *)NULL), from, numBytes); return objPtr; } diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 90301aa..0e6324c 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -818,8 +818,8 @@ Tcl_AfterObjCmd( */ if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { - if (Tcl_GetIndexFromObjStruct(NULL, objv[1], afterSubCmds, - sizeof(char *), "", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) + != TCL_OK) { const char *arg = TclGetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 269d8bc..85b57a5 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -2409,7 +2409,7 @@ ZipFSMkKeyObjCmd( } passObj = Tcl_NewByteArrayObj(NULL, 264); - passBuf = Tcl_GetBytesFromObj(NULL, passObj, NULL); + passBuf = Tcl_GetBytesFromObj(NULL, passObj, (size_t *)NULL); while (len > 0) { int ch = pw[len - 1]; @@ -3776,8 +3776,8 @@ ZipFSListObjCmd( if (objc == 3) { int idx; - if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, - sizeof(char *), "option", 0, &idx) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", + 0, &idx) != TCL_OK) { return TCL_ERROR; } switch (idx) { @@ -4998,8 +4998,7 @@ ZipFSMatchInDirectoryProc( Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - int scnt, l, dirOnly = -1, prefixLen, strip = 0, mounts = 0; - int len; + int scnt, l, dirOnly = -1, prefixLen, strip = 0, mounts = 0, len; char *pat, *prefix, *path; Tcl_DString dsPref, *prefixBuf = NULL; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index fa87a10..8a95fd5 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -496,8 +496,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "type", &value) != TCL_OK) { goto error; - } else if (value != NULL && Tcl_GetIndexFromObjStruct(interp, value, types, - sizeof(char *), "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) { + } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types, + "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) { goto error; } @@ -1155,7 +1155,7 @@ Tcl_ZlibStreamSetCompressionDictionary( ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; if (compressionDictionaryObj && (NULL == Tcl_GetBytesFromObj(NULL, - compressionDictionaryObj, NULL))) { + compressionDictionaryObj, (size_t *)NULL))) { /* Missing or invalid compression dictionary */ compressionDictionaryObj = NULL; } @@ -1972,8 +1972,8 @@ ZlibCmd( Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], commands, - sizeof(char *), "command", 0, &command) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0, + &command) != TCL_OK) { return TCL_ERROR; } @@ -2351,7 +2351,7 @@ ZlibStreamSubcmd( } if (compDictObj) { - if (NULL == (Tcl_GetBytesFromObj)(interp, compDictObj, NULL)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) { return TCL_ERROR; } } @@ -2533,7 +2533,7 @@ ZlibPushSubcmd( } } - if (compDictObj && (NULL == (Tcl_GetBytesFromObj)(interp, compDictObj, NULL))) { + if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL))) { return TCL_ERROR; } @@ -3330,7 +3330,7 @@ ZlibTransformSetOption( /* not used */ TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); - if (NULL == (Tcl_GetBytesFromObj)(interp, compDictObj, NULL)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) { Tcl_DecrRefCount(compDictObj); return TCL_ERROR; } @@ -3721,7 +3721,7 @@ ZlibStackChannelTransform( if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); - (Tcl_GetBytesFromObj)(NULL, cd->compDictObj, NULL); + Tcl_GetBytesFromObj(NULL, cd->compDictObj, (size_t *)NULL); } if (format == TCL_ZLIB_FORMAT_RAW) { -- cgit v0.12 From fb6284e74892e0451649cff40291378b663dd448 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 26 Apr 2022 13:25:01 +0000 Subject: fixes build using msys/mingw toolchain, missing build path as include caused: generic/tclEvent.c:17:10: fatal error: tclUuid.h: No such file or directory (cherry picked from unix/Makefile.in) --- win/Makefile.in | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/win/Makefile.in b/win/Makefile.in index 4a4979d..1464792 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -98,6 +98,7 @@ COMPILE_DEBUG_FLAGS = SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. TOP_DIR = $(shell cd @srcdir@/..; pwd -W 2>/dev/null || pwd -P) +BUILD_DIR = @builddir@ GENERIC_DIR = $(TOP_DIR)/generic WIN_DIR = $(TOP_DIR)/win COMPAT_DIR = $(TOP_DIR)/compat @@ -251,7 +252,7 @@ MINIZIP_OBJS = \ ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@ -CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ +CC_SWITCHES = -I"${BUILD_DIR}" -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ -I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} -- cgit v0.12 From 9f54abf33a1289128b25b82e8a2d53013463801e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 Apr 2022 15:07:32 +0000 Subject: Change value of TCL_INDEX_TEMP_TABLE from 2 to 64, and let it lead to a slightly more efficient implementation of Tcl_GetIndexFromObj*() (TIP #613) --- generic/tcl.h | 6 +++--- generic/tclDecls.h | 4 ++-- generic/tclIndexObj.c | 21 +++++++++++---------- 3 files changed, 16 insertions(+), 15 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index eff58b3..79e4174 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -977,15 +977,15 @@ typedef struct Tcl_DString { /* * Flags that may be passed to Tcl_GetIndexFromObj. * 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; + * 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. */ #define TCL_EXACT 1 -#define TCL_INDEX_TEMP_TABLE 2 #define TCL_INDEX_NULL_OK 32 +#define TCL_INDEX_TEMP_TABLE 64 /* *---------------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 266c265..624903e 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4252,7 +4252,7 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(sizePtr)) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ - (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<8), (indexPtr))) + (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)(sizePtr))) @@ -4265,7 +4265,7 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)(sizePtr)) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ - ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<8), (indexPtr))) + ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)(sizePtr)) : (TclGetStringFromObj)(objPtr, (size_t *)(sizePtr))) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 1f600c5..e1526ad 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -369,20 +369,21 @@ Tcl_GetIndexFromObjStruct( uncachedDone: if (indexPtr != NULL) { - if ((flags>>8) & (int)~sizeof(int)) { - if ((flags>>8) == sizeof(uint64_t)) { - *(uint64_t *)indexPtr = index; - return TCL_OK; - } else if ((flags>>8) == sizeof(uint32_t)) { - *(uint32_t *)indexPtr = index; - return TCL_OK; - } else if ((flags>>8) == sizeof(uint16_t)) { + flags &= (30-(int)(sizeof(int)<<1)); + if (flags) { + if (flags == sizeof(uint16_t)<<1) { *(uint16_t *)indexPtr = index; return TCL_OK; - } else if ((flags>>8) == sizeof(uint8_t)) { + } else if (flags == (int)(sizeof(uint8_t)<<1)) { *(uint8_t *)indexPtr = index; return TCL_OK; - } + } else if (flags == (int)(sizeof(int64_t)<<1)) { + *(int64_t *)indexPtr = index; + return TCL_OK; + } else if (flags == (int)(sizeof(int32_t)<<1)) { + *(int32_t *)indexPtr = index; + return TCL_OK; + } } *(int *)indexPtr = index; } -- cgit v0.12