summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tcl.h6
-rw-r--r--generic/tclCompCmdsSZ.c3
-rw-r--r--generic/tclDecls.h11
-rw-r--r--generic/tclExecute.c2
-rw-r--r--generic/tclIO.c4
-rw-r--r--generic/tclIndexObj.c21
-rw-r--r--generic/tclStringObj.c6
-rw-r--r--generic/tclTimer.c4
-rw-r--r--generic/tclZipfs.c9
-rw-r--r--generic/tclZlib.c18
-rw-r--r--tests/error.test7
-rw-r--r--win/Makefile.in3
12 files changed, 55 insertions, 39 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index 7d8be54..44ea473 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -824,15 +824,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
/*
* Flags that may be passed to Tcl_UniCharToUtf.
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 64c6fcc..875cede 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2980,6 +2980,9 @@ TclCompileTryCmd(
goto failedToCompile;
}
finallyToken = TokenAfter(tokenPtr);
+ if (finallyToken->type != TCL_TOKEN_SIMPLE_WORD) {
+ goto failedToCompile;
+ }
} else {
goto failedToCompile;
}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index d2bc9b7..79db673 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -3908,24 +3908,29 @@ 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) \
(sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tcl_GetUnicodeFromObj(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)))
#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) \
- ((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)))
#endif
#ifdef TCL_MEM_DEBUG
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f5923a1..9df881e 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/tclIndexObj.c b/generic/tclIndexObj.c
index c369827..567bdc5 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -300,20 +300,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;
}
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index c8c6081..91cf9dc 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1465,7 +1465,7 @@ Tcl_AppendObjToObj(
*/
TclAppendBytesToByteArray(objPtr,
- (Tcl_GetBytesFromObj)(NULL, appendObjPtr, NULL), lengthSrc);
+ Tcl_GetBytesFromObj(NULL, appendObjPtr, (size_t *)NULL), lengthSrc);
return;
}
@@ -2982,7 +2982,7 @@ TclStringRepeat(
done *= 2;
}
TclAppendBytesToByteArray(objResultPtr,
- (Tcl_GetBytesFromObj)(NULL, objResultPtr, NULL),
+ Tcl_GetBytesFromObj(NULL, objResultPtr, (size_t *)NULL),
(count - done) * length);
} else if (unichar) {
/*
@@ -3859,7 +3859,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) {
diff --git a/tests/error.test b/tests/error.test
index 064edc7..4ce7709 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
diff --git a/win/Makefile.in b/win/Makefile.in
index 0116e8b..b5aed05 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}
generated by cgit v0.12 at 2024-11-16 03:00:45 (GMT)