summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCompCmdsSZ.c1
-rw-r--r--generic/tclExecute.c35
-rw-r--r--generic/tclIOUtil.c4
-rw-r--r--generic/tclStubInit.c10
-rw-r--r--generic/tclZipfs.c4
-rw-r--r--tests/oo.test4
-rwxr-xr-xunix/configure2
-rw-r--r--unix/tcl.m42
-rw-r--r--unix/tclUnixThrd.c4
-rw-r--r--win/tclWinInit.c12
10 files changed, 58 insertions, 20 deletions
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index db51890..f665e0a 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -694,6 +694,7 @@ TclCompileStringIsCmd(
OP( LNOT);
return TCL_OK;
}
+ break;
case STR_IS_DOUBLE: {
int satisfied, isEmpty;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 3d75d97..7d3d6bd 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -317,12 +317,16 @@ VarHashCreateVar(
switch (*pc) { \
case INST_JUMP_FALSE1: \
NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+ break; \
case INST_JUMP_TRUE1: \
NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+ break; \
case INST_JUMP_FALSE4: \
NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+ break; \
case INST_JUMP_TRUE4: \
NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+ break; \
default: \
if ((condition) < 0) { \
TclNewIntObj(objResultPtr, -1); \
@@ -330,6 +334,7 @@ VarHashCreateVar(
objResultPtr = TCONST((condition) > 0); \
} \
NEXT_INST_F(0, (cleanup), 1); \
+ break; \
} \
} while (0)
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
@@ -338,12 +343,16 @@ VarHashCreateVar(
switch (*pc) { \
case INST_JUMP_FALSE1: \
NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+ break; \
case INST_JUMP_TRUE1: \
NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+ break; \
case INST_JUMP_FALSE4: \
NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+ break; \
case INST_JUMP_TRUE4: \
NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+ break; \
default: \
if ((condition) < 0) { \
TclNewIntObj(objResultPtr, -1); \
@@ -351,6 +360,7 @@ VarHashCreateVar(
objResultPtr = TCONST((condition) > 0); \
} \
NEXT_INST_V(0, (cleanup), 1); \
+ break; \
} \
} while (0)
#else /* TCL_COMPILE_DEBUG */
@@ -2581,23 +2591,27 @@ TEBCresume(
objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
NEXT_INST_F(5, 0, 1);
+ break;
case INST_POP:
TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
objPtr = POP_OBJECT();
TclDecrRefCount(objPtr);
NEXT_INST_F(1, 0, 0);
+ break;
case INST_DUP:
objResultPtr = OBJ_AT_TOS;
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
+ break;
case INST_OVER:
opnd = TclGetUInt4AtPtr(pc+1);
objResultPtr = OBJ_AT_DEPTH(opnd);
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_F(5, 0, 1);
+ break;
case INST_REVERSE: {
Tcl_Obj **a, **b;
@@ -2628,6 +2642,7 @@ TEBCresume(
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
+ break;
case INST_CONCAT_STK:
/*
@@ -2639,6 +2654,7 @@ TEBCresume(
objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1));
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(5, opnd, 1);
+ break;
case INST_EXPAND_START:
/*
@@ -2660,6 +2676,7 @@ TEBCresume(
PUSH_TAUX_OBJ(objPtr);
TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
NEXT_INST_F(1, 0, 0);
+ break;
case INST_EXPAND_DROP:
/*
@@ -2786,6 +2803,7 @@ TEBCresume(
TclNewObj(objResultPtr);
NEXT_INST_F(1, 0, 1);
+ break;
case INST_INVOKE_STK4:
objc = TclGetUInt4AtPtr(pc+1);
@@ -4267,6 +4285,7 @@ TEBCresume(
TRACE(("%d => new pc %u\n", opnd,
(unsigned)(pc + opnd - codePtr->codeStart)));
NEXT_INST_F(opnd, 0, 0);
+ break;
case INST_JUMP4:
opnd = TclGetInt4AtPtr(pc+1);
@@ -4436,6 +4455,7 @@ TEBCresume(
TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
+ break;
case INST_INFO_LEVEL_ARGS: {
int level;
CallFrame *framePtr = iPtr->varFramePtr;
@@ -5667,7 +5687,6 @@ TEBCresume(
JUMP_PEEPHOLE_F(match, 2, 2);
}
- break;
/*
* End of string-related instructions.
@@ -6097,6 +6116,7 @@ TEBCresume(
TclSetIntObj(valuePtr, wResult);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
+ break;
case INST_DIV:
if (w2 == 0) {
@@ -6239,6 +6259,7 @@ TEBCresume(
/* -NaN => NaN */
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
+ break;
case TCL_NUMBER_INT:
w1 = *((const Tcl_WideInt *) ptr1);
if (w1 != WIDE_MIN) {
@@ -6364,6 +6385,7 @@ TEBCresume(
}
TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
NEXT_INST_F(1, 0, 1);
+ break;
case INST_BREAK:
/*
@@ -6759,6 +6781,7 @@ TEBCresume(
TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
(int) CURR_DEPTH));
NEXT_INST_F(5, 0, 0);
+ break;
case INST_END_CATCH:
catchTop--;
@@ -6768,6 +6791,7 @@ TEBCresume(
result = TCL_OK;
TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
NEXT_INST_F(1, 0, 0);
+ break;
case INST_PUSH_RESULT:
objResultPtr = Tcl_GetObjResult(interp);
@@ -6781,11 +6805,13 @@ TEBCresume(
Tcl_IncrRefCount(objPtr);
iPtr->objResultPtr = objPtr;
NEXT_INST_F(1, 0, -1);
+ break;
case INST_PUSH_RETURN_CODE:
TclNewIntObj(objResultPtr, result);
TRACE(("=> %u\n", result));
NEXT_INST_F(1, 0, 1);
+ break;
case INST_PUSH_RETURN_OPTIONS:
DECACHE_STACK_INFO();
@@ -6793,6 +6819,7 @@ TEBCresume(
CACHE_STACK_INFO();
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
+ break;
case INST_RETURN_CODE_BRANCH: {
int code;
@@ -6832,6 +6859,7 @@ TEBCresume(
}
TRACE_APPEND(("OK\n"));
NEXT_INST_F(1, 1, 0);
+ break;
case INST_DICT_EXISTS: {
int found;
@@ -8886,6 +8914,7 @@ TclCompareTwoNumbers(
mp_clear(&big2);
return compare;
}
+ break;
case TCL_NUMBER_DOUBLE:
d1 = *((const double *)ptr1);
@@ -8932,6 +8961,7 @@ TclCompareTwoNumbers(
Tcl_InitBignumFromDouble(NULL, d1, &big1);
goto bigCompare;
}
+ break;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
@@ -8968,10 +8998,11 @@ TclCompareTwoNumbers(
mp_clear(&big2);
return compare;
}
+ break;
default:
Tcl_Panic("unexpected number type");
- return TCL_ERROR;
}
+ return TCL_ERROR;
}
#ifdef TCL_COMPILE_DEBUG
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 28e1df5..622fec6 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -171,7 +171,7 @@ const Tcl_Filesystem tclNativeFilesystem = {
TclpObjCopyDirectory,
TclpObjLstat,
/* Needs casts since we're using version_2. */
- (Tcl_FSLoadFileProc *) TclpDlopen,
+ (Tcl_FSLoadFileProc *)(void *) TclpDlopen,
(Tcl_FSGetCwdProc *) TclpGetNativeCwd,
TclpObjChdir
};
@@ -3176,7 +3176,7 @@ Tcl_LoadFile(
}
if (fsPtr->loadFileProc != NULL) {
- int retVal = ((Tcl_FSLoadFileProc2 *)(fsPtr->loadFileProc))
+ int retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc))
(interp, pathPtr, handlePtr, &unloadProcPtr, flags);
if (retVal == TCL_OK) {
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 6983113..c1daddf 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -151,7 +151,7 @@ static mp_err TclBN_mp_set_long(mp_int *a, unsigned long i)
return MP_OKAY;
}
-#define TclBN_mp_set_ul (void (*)(mp_int *a, unsigned long i))TclBN_mp_set_long
+#define TclBN_mp_set_ul (void (*)(mp_int *a, unsigned long i))(void *)TclBN_mp_set_long
mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) {
return mp_expt_u32(a, b, c);
@@ -483,19 +483,19 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n);
}
-#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp
+#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcmp
static int utfNcmp(const char *s1, const char *s2, unsigned int n){
return Tcl_UtfNcmp(s1, s2, (unsigned long)n);
}
-#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp
+#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcmp
static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n);
}
-#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp
+#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp
static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
}
-#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
+#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcasecmp
#endif /* TCL_WIDE_INT_IS_LONG */
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 393db5c..9aa26d9 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -430,7 +430,7 @@ static const Tcl_Filesystem zipfsFilesystem = {
NULL, /* renameFileProc */
NULL, /* copyDirectoryProc */
NULL, /* lstatProc */
- (Tcl_FSLoadFileProc *) ZipFSLoadFile,
+ (Tcl_FSLoadFileProc *)(void *)ZipFSLoadFile,
NULL, /* getCwdProc */
NULL, /* chdirProc */
};
@@ -4696,7 +4696,7 @@ ZipFSLoadFile(
Tcl_DecrRefCount(objs[1]);
}
- loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
+ loadFileProc = (Tcl_FSLoadFileProc2 *)(void *)tclNativeFilesystem.loadFileProc;
if (loadFileProc) {
ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
} else {
diff --git a/tests/oo.test b/tests/oo.test
index 235a90d..3b56f30 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -111,8 +111,8 @@ test oo-0.8 {leak in variable management} -setup {
} -result 0
test oo-0.9 {various types of presence of the TclOO package} {
list [lsearch -nocase -all -inline [package names] tcloo] \
- [package present TclOO] [package versions TclOO]
-} [list TclOO $::oo::patchlevel $::oo::patchlevel]
+ [package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}]
+} [list TclOO $::oo::patchlevel 1]
test oo-1.1 {basic test of OO functionality: no classes} {
set result {}
diff --git a/unix/configure b/unix/configure
index 1098ba8..8fc9a13 100755
--- a/unix/configure
+++ b/unix/configure
@@ -6583,7 +6583,7 @@ fi
if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then :
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
- MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
if test "${SHLIB_SUFFIX}" = ".dll"; then :
INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 9c88a42..6bfb10e 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1821,7 +1821,7 @@ dnl # preprocessing tests use only CPPFLAGS.
AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
- MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [
INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 35eca8d..054a5d2 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -266,9 +266,9 @@ TclpThreadCreate(
}
if (pthread_create(&theThread, &attr,
- (void * (*)(void *)) proc, (void *) clientData) &&
+ (void * (*)(void *))(void *)proc, (void *) clientData) &&
pthread_create(&theThread, NULL,
- (void * (*)(void *)) proc, (void *) clientData)) {
+ (void * (*)(void *))(void *)proc, (void *) clientData)) {
result = TCL_ERROR;
} else {
*idPtr = (Tcl_ThreadId) theThread;
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 0d37d1a..09e98e2 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -454,10 +454,16 @@ const char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
{
+ UINT acp = GetACP();
+
Tcl_DStringInit(bufPtr);
- Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
- wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
- Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
+ if (acp == CP_UTF8) {
+ Tcl_DStringAppend(bufPtr, "utf-8", 5);
+ } else {
+ Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
+ wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
+ Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
+ }
return Tcl_DStringValue(bufPtr);
}
generated by cgit v0.12 at 2025-12-25 13:47:57 (GMT)