summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/Notifier.32
-rw-r--r--generic/rege_dfa.c2
-rw-r--r--generic/regexec.c2
-rw-r--r--generic/tcl.decls2
-rw-r--r--generic/tclBasic.c35
-rw-r--r--generic/tclDecls.h6
-rw-r--r--generic/tclExecute.c12
-rw-r--r--generic/tclInt.decls10
-rw-r--r--generic/tclInt.h18
-rw-r--r--generic/tclIntDecls.h23
-rw-r--r--generic/tclNotify.c2
-rw-r--r--generic/tclOOCall.c4
-rw-r--r--generic/tclStringObj.c10
-rw-r--r--generic/tclStubInit.c8
-rw-r--r--generic/tclTest.c164
-rw-r--r--generic/tclTestObj.c218
-rw-r--r--generic/tclVar.c40
-rw-r--r--tests/string.test3
-rwxr-xr-xtools/tcltk-man2html.tcl2
-rwxr-xr-xunix/config.status.lineno8
-rw-r--r--unix/tclUnixCompat.c5
-rw-r--r--unix/tclXtNotify.c13
-rw-r--r--win/makefile.vc3
-rw-r--r--win/rules.vc4
24 files changed, 329 insertions, 267 deletions
diff --git a/doc/Notifier.3 b/doc/Notifier.3
index ec9f910..efbe216 100644
--- a/doc/Notifier.3
+++ b/doc/Notifier.3
@@ -103,7 +103,7 @@ passed to \fBTcl_DoOneEvent\fR.
.AP int mode in
Indicates whether events should be serviced by \fBTcl_ServiceAll\fR.
Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
-.AP Tcl_NotifierProcs* notifierProcPtr in
+.AP const Tcl_NotifierProcs* notifierProcPtr in
Structure of function pointers describing notifier procedures that are
to replace the ones installed in the executable. See
\fBREPLACING THE NOTIFIER\fR for details.
diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c
index f38c8c9..eddfea2 100644
--- a/generic/rege_dfa.c
+++ b/generic/rege_dfa.c
@@ -419,7 +419,7 @@ freeDFA(
static unsigned
hash(
unsigned *const uv,
- const int n)
+ int n)
{
int i;
unsigned h;
diff --git a/generic/regexec.c b/generic/regexec.c
index c085ac6..510fb1d 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -145,7 +145,7 @@ static chr *shortest(struct vars *const, struct dfa *const, chr *const, chr *con
static chr *lastCold(struct vars *const, struct dfa *const);
static struct dfa *newDFA(struct vars *const, struct cnfa *const, struct colormap *const, struct smalldfa *);
static void freeDFA(struct dfa *const);
-static unsigned hash(unsigned *const, const int);
+static unsigned hash(unsigned *const, int);
static struct sset *initialize(struct vars *const, struct dfa *const, chr *const);
static struct sset *miss(struct vars *const, struct dfa *const, struct sset *const, const pcolor, chr *const, chr *const);
static int checkLAConstraint(struct vars *const, struct cnfa *const, chr *const, const pcolor);
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 58b217b..a33ea56 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1365,7 +1365,7 @@ declare 385 {
Tcl_Obj *patternObj)
}
declare 386 {
- void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr)
+ void Tcl_SetNotifier(const Tcl_NotifierProcs *notifierProcPtr)
}
declare 387 {
Tcl_Mutex *Tcl_GetAllocMutex(void)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ae7a3dc..74cb683 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -233,8 +233,8 @@ MODULE_SCOPE const TclStubs tclStubs;
* after particular kinds of [yield].
*/
-#define CORO_ACTIVATE_YIELD PTR2INT(NULL)
-#define CORO_ACTIVATE_YIELDM PTR2INT(NULL)+1
+#define CORO_ACTIVATE_YIELD NULL
+#define CORO_ACTIVATE_YIELDM INT2PTR(1)
#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1)
#define COROUTINE_ARGUMENTS_ARBITRARY (-2)
@@ -9563,7 +9563,7 @@ TclNRYieldToObjCmd(
corPtr->yieldPtr = listPtr;
iPtr->execEnvPtr = corPtr->eePtr;
- return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
+ return TclNRYieldObjCmd(CORO_ACTIVATE_YIELDM, interp, 1, objv);
}
static int
@@ -9724,9 +9724,6 @@ TclNRCoroutineActivateCallback(
TCL_UNUSED(int) /*result*/)
{
CoroutineData *corPtr = (CoroutineData *)data[0];
- int type = PTR2INT(data[1]);
- int numLevels, unused;
- int *stackLevel = &unused;
if (!corPtr->stackLevel) {
/*
@@ -9743,8 +9740,8 @@ TclNRCoroutineActivateCallback(
* the interp's environment to make it suitable to run this coroutine.
*/
- corPtr->stackLevel = stackLevel;
- numLevels = corPtr->auxNumLevels;
+ corPtr->stackLevel = &corPtr;
+ int numLevels = corPtr->auxNumLevels;
corPtr->auxNumLevels = iPtr->numLevels;
SAVE_CONTEXT(corPtr->caller);
@@ -9757,7 +9754,7 @@ TclNRCoroutineActivateCallback(
* Coroutine is active: yield
*/
- if (corPtr->stackLevel != stackLevel) {
+ if (corPtr->stackLevel != &corPtr) {
NRE_callback *runPtr;
iPtr->execEnvPtr = corPtr->callerEEPtr;
@@ -9781,6 +9778,7 @@ TclNRCoroutineActivateCallback(
return TCL_ERROR;
}
+ void *type = data[1];
if (type == CORO_ACTIVATE_YIELD) {
corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
} else if (type == CORO_ACTIVATE_YIELDM) {
@@ -9792,7 +9790,7 @@ TclNRCoroutineActivateCallback(
corPtr->yieldPtr = NULL;
corPtr->stackLevel = NULL;
- numLevels = iPtr->numLevels;
+ int numLevels = iPtr->numLevels;
iPtr->numLevels = corPtr->auxNumLevels;
corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
@@ -9939,7 +9937,6 @@ TclNRCoroInjectObjCmd(
Tcl_Obj *const objv[])
{
CoroutineData *corPtr;
- ExecEnv *savedEEPtr = iPtr->execEnvPtr;
/*
* Usage more or less like tailcall:
@@ -9968,6 +9965,7 @@ TclNRCoroInjectObjCmd(
* to happen when the coro is resumed.
*/
+ ExecEnv *savedEEPtr = iPtr->execEnvPtr;
iPtr->execEnvPtr = corPtr->eePtr;
TclNRAddCallback(interp, InjectHandler, corPtr,
Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL);
@@ -9984,9 +9982,6 @@ TclNRCoroProbeObjCmd(
Tcl_Obj *const objv[])
{
CoroutineData *corPtr;
- ExecEnv *savedEEPtr = iPtr->execEnvPtr;
- int numLevels, unused;
- int *stackLevel = &unused;
/*
* Usage more or less like tailcall:
@@ -10016,6 +10011,7 @@ TclNRCoroProbeObjCmd(
* to happen when the coro is resumed.
*/
+ ExecEnv *savedEEPtr = iPtr->execEnvPtr;
iPtr->execEnvPtr = corPtr->eePtr;
TclNRAddCallback(interp, InjectHandler, corPtr,
Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr);
@@ -10036,8 +10032,8 @@ TclNRCoroProbeObjCmd(
* the interp's environment to make it suitable to run this coroutine.
*/
- corPtr->stackLevel = stackLevel;
- numLevels = corPtr->auxNumLevels;
+ corPtr->stackLevel = &corPtr;
+ int numLevels = corPtr->auxNumLevels;
corPtr->auxNumLevels = iPtr->numLevels;
/*
@@ -10082,7 +10078,7 @@ InjectHandler(
CoroutineData *corPtr = (CoroutineData *)data[0];
Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
int nargs = PTR2INT(data[2]);
- ClientData isProbe = data[3];
+ void *isProbe = data[3];
int objc;
Tcl_Obj **objv;
@@ -10128,8 +10124,7 @@ InjectHandlerPostCall(
CoroutineData *corPtr = (CoroutineData *)data[0];
Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
int nargs = PTR2INT(data[2]);
- ClientData isProbe = data[3];
- int numLevels;
+ void *isProbe = data[3];
/*
* Delete the command words for what we just executed.
@@ -10151,7 +10146,7 @@ InjectHandlerPostCall(
}
corPtr->nargs = nargs;
corPtr->stackLevel = NULL;
- numLevels = iPtr->numLevels;
+ int numLevels = iPtr->numLevels;
iPtr->numLevels = corPtr->auxNumLevels;
corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
iPtr->execEnvPtr = corPtr->callerEEPtr;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index cc738f1..0830a11 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1164,7 +1164,8 @@ void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp,
Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
-EXTERN void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
+EXTERN void Tcl_SetNotifier(
+ const Tcl_NotifierProcs *notifierProcPtr);
/* 387 */
EXTERN Tcl_Mutex * Tcl_GetAllocMutex(void);
/* 388 */
@@ -2383,7 +2384,7 @@ typedef struct TclStubs {
Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
TCL_DEPRECATED_API("Use Tcl_AppendStringsToObj") void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
- void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */
+ void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */
Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
@@ -4129,7 +4130,6 @@ extern const TclStubs *tclStubsPtr;
#undef Tcl_GetStringResult
#undef Tcl_GetDefaultEncodingDir
#undef Tcl_SetDefaultEncodingDir
-#undef Tcl_UniCharLen
#undef Tcl_UniCharNcmp
#undef Tcl_EvalTokens
#undef Tcl_UniCharNcasecmp
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d6aa551..0ec2404 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2425,7 +2425,7 @@ TEBCresume(
{
CoroutineData *corPtr;
- int yieldParameter;
+ void *yieldParameter;
case INST_YIELD:
corPtr = iPtr->execEnvPtr->corPtr;
@@ -2453,7 +2453,7 @@ TEBCresume(
fflush(stdout);
}
#endif
- yieldParameter = 0;
+ yieldParameter = NULL; /*==CORO_ACTIVATE_YIELD*/
Tcl_SetObjResult(interp, OBJ_AT_TOS);
goto doYield;
@@ -2508,7 +2508,7 @@ TEBCresume(
TclSetTailcall(interp, valuePtr);
corPtr->yieldPtr = valuePtr;
iPtr->execEnvPtr = corPtr->eePtr;
- yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/
+ yieldParameter = INT2PTR(1); /*==CORO_ACTIVATE_YIELDM*/
doYield:
/* TIP #280: Record the last piece of info needed by
@@ -2526,7 +2526,7 @@ TEBCresume(
cleanup = 1;
TEBC_YIELD();
TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
- INT2PTR(yieldParameter), NULL, NULL);
+ yieldParameter, NULL, NULL);
return TCL_OK;
}
@@ -8277,9 +8277,9 @@ ExecuteExtendedBinaryMathOp(
&& ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
w1 = *((const Tcl_WideInt *)ptr1);
if (!((w1>0 ? w1 : ~w1)
- & -(((Tcl_WideInt)1)
+ & -(((Tcl_WideUInt)1)
<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
- WIDE_RESULT(w1 << shift);
+ WIDE_RESULT((Tcl_WideUInt)w1 << shift);
}
}
} else {
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 0b3ea9e..8cefc34 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -904,7 +904,7 @@ declare 229 {
declare 230 {
Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
const char *part2, int flags, const char *msg,
- const int createPart1, const int createPart2, Var **arrayPtrPtr)
+ int createPart1, int createPart2, Var **arrayPtrPtr)
}
declare 231 {
int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -1005,17 +1005,17 @@ declare 251 {
declare 252 {
Tcl_Obj *TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
- const int flags)
+ int flags)
}
declare 253 {
Tcl_Obj *TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
- Tcl_Obj *newValuePtr, const int flags)
+ Tcl_Obj *newValuePtr, int flags)
}
declare 254 {
Tcl_Obj *TclPtrIncrObjVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
- Tcl_Obj *incrPtr, const int flags)
+ Tcl_Obj *incrPtr, int flags)
}
declare 255 {
int TclPtrObjMakeUpvar(Tcl_Interp *interp, Tcl_Var otherPtr,
@@ -1023,7 +1023,7 @@ declare 255 {
}
declare 256 {
int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
- Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
+ Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags)
}
declare 257 {
void TclStaticLibrary(Tcl_Interp *interp, const char *prefix,
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 75cd6e5..3f2d1ad 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4126,30 +4126,30 @@ MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags);
MODULE_SCOPE Var * TclObjLookupVarEx(Tcl_Interp * interp,
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags,
- const char *msg, const int createPart1,
- const int createPart2, Var **arrayPtrPtr);
+ const char *msg, int createPart1,
+ int createPart2, Var **arrayPtrPtr);
MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp,
Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr,
- const int flags, const char *msg,
- const int createPart1, const int createPart2,
+ int flags, const char *msg,
+ int createPart1, int createPart2,
Var *arrayPtr, int index);
MODULE_SCOPE Tcl_Obj * TclPtrGetVarIdx(Tcl_Interp *interp,
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr, const int flags, int index);
+ Tcl_Obj *part2Ptr, int flags, int index);
MODULE_SCOPE Tcl_Obj * TclPtrSetVarIdx(Tcl_Interp *interp,
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
- const int flags, int index);
+ int flags, int index);
MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVarIdx(Tcl_Interp *interp,
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
- const int flags, int index);
+ int flags, int index);
MODULE_SCOPE int TclPtrObjMakeUpvarIdx(Tcl_Interp *interp,
Var *otherPtr, Tcl_Obj *myNamePtr, int myFlags,
int index);
MODULE_SCOPE int TclPtrUnsetVarIdx(Tcl_Interp *interp, Var *varPtr,
Var *arrayPtr, Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr, const int flags,
+ Tcl_Obj *part2Ptr, int flags,
int index);
MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr,
@@ -4510,7 +4510,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
(objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
} else { \
- (objPtr)->bytes = (char *)ckalloc((len) + 1); \
+ (objPtr)->bytes = (char *)ckalloc((unsigned int)(len) + 1U); \
memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 75f4a68..f4e657b 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -562,9 +562,8 @@ EXTERN int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
/* 230 */
EXTERN Var * TclObjLookupVar(Tcl_Interp *interp,
Tcl_Obj *part1Ptr, const char *part2,
- int flags, const char *msg,
- const int createPart1, const int createPart2,
- Var **arrayPtrPtr);
+ int flags, const char *msg, int createPart1,
+ int createPart2, Var **arrayPtrPtr);
/* 231 */
EXTERN int TclGetNamespaceFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
@@ -631,17 +630,17 @@ EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes,
/* 252 */
EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr, const int flags);
+ Tcl_Obj *part2Ptr, int flags);
/* 253 */
EXTERN Tcl_Obj * TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
- const int flags);
+ int flags);
/* 254 */
EXTERN Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
- const int flags);
+ int flags);
/* 255 */
EXTERN int TclPtrObjMakeUpvar(Tcl_Interp *interp,
Tcl_Var otherPtr, Tcl_Obj *myNamePtr,
@@ -649,7 +648,7 @@ EXTERN int TclPtrObjMakeUpvar(Tcl_Interp *interp,
/* 256 */
EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr, const int flags);
+ Tcl_Obj *part2Ptr, int flags);
/* 257 */
EXTERN void TclStaticLibrary(Tcl_Interp *interp,
const char *prefix,
@@ -895,7 +894,7 @@ typedef struct TclIntStubs {
void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */
void (*reserved228)(void);
int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
- Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
+ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 230 */
int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
@@ -917,11 +916,11 @@ typedef struct TclIntStubs {
char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
- Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
- Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
- Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
+ Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */
+ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */
+ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); /* 254 */
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
- int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
+ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
void (*tclUnusedStubEntry) (void); /* 259 */
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index 12b40b1..1140168 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -226,7 +226,7 @@ TclFinalizeNotifier(void)
void
Tcl_SetNotifier(
- Tcl_NotifierProcs *notifierProcPtr)
+ const Tcl_NotifierProcs *notifierProcPtr)
{
tclNotifierHooks = *notifierProcPtr;
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 71db6c1..d265c1a 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -91,7 +91,7 @@ typedef struct {
static void AddClassFiltersToCallContext(Object *const oPtr,
Class *clsPtr, struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags);
-static void AddClassMethodNames(Class *clsPtr, const int flags,
+static void AddClassMethodNames(Class *clsPtr, int flags,
Tcl_HashTable *const namesPtr,
Tcl_HashTable *const examinedClassesPtr);
static inline void AddDefinitionNamespaceToChain(Class *const definerCls,
@@ -671,7 +671,7 @@ CmpStr(
static void
AddClassMethodNames(
Class *clsPtr, /* Class to get method names from. */
- const int flags, /* Whether we are interested in just the
+ int flags, /* Whether we are interested in just the
* public method names. */
Tcl_HashTable *const namesPtr,
/* Reference to the hash table to put the
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index f240bc0..7d4aef3 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -561,7 +561,7 @@ Tcl_GetUniChar(
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
- return (Tcl_UniChar) objPtr->bytes[index];
+ return (unsigned char) objPtr->bytes[index];
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
@@ -914,9 +914,9 @@ Tcl_SetObjLength(
* Need to enlarge the buffer.
*/
if (objPtr->bytes == &tclEmptyString) {
- objPtr->bytes = (char *)ckalloc(length + 1);
+ objPtr->bytes = (char *)ckalloc((unsigned int)length + 1U);
} else {
- objPtr->bytes = (char *)ckrealloc(objPtr->bytes, length + 1);
+ objPtr->bytes = (char *)ckrealloc(objPtr->bytes, (unsigned int)length + 1U);
}
stringPtr->allocated = length;
}
@@ -1020,9 +1020,9 @@ Tcl_AttemptSetObjLength(
char *newBytes;
if (objPtr->bytes == &tclEmptyString) {
- newBytes = (char *)attemptckalloc(length + 1);
+ newBytes = (char *)attemptckalloc((unsigned int)length + 1U);
} else {
- newBytes = (char *)attemptckrealloc(objPtr->bytes, length + 1);
+ newBytes = (char *)attemptckrealloc(objPtr->bytes, (unsigned int)length + 1U);
}
if (newBytes == NULL) {
return 0;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index f33f1dd..257c3ce 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -86,14 +86,13 @@
static void uniCodePanic(void) {
Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}
-# define Tcl_GetUnicode (int *(*)(Tcl_Obj *))(void *)uniCodePanic
-# define Tcl_GetUnicodeFromObj (int *(*)(Tcl_Obj *, Tcl_UniChar *))(void *)uniCodePanic
-# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, Tcl_UniChar))(void *)uniCodePanic
+# define Tcl_GetUnicode (Tcl_UniChar *(*)(Tcl_Obj *))(void *)uniCodePanic
+# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
+# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, int))(void *)uniCodePanic
# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic
# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic
# define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic
# define Tcl_UniCharCaseMatch (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, int))(void *)uniCodePanic
-# define Tcl_UniCharLen (int(*)(const Tcl_UniChar *))(void *)uniCodePanic
# define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic
#endif
@@ -688,7 +687,6 @@ static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
#if TCL_UTF_MAX < 4
# define Tcl_AppendUnicodeToObj 0
# define Tcl_UniCharCaseMatch 0
-# define Tcl_UniCharLen 0
# define Tcl_UniCharNcasecmp 0
# define Tcl_UniCharNcmp 0
#endif
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 009c95f..0ce5e83 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -41,6 +41,8 @@
*/
#include "tclIO.h"
+#include "tclUuid.h"
+
/*
* Declare external functions used in Windows tests.
*/
@@ -333,7 +335,7 @@ static Tcl_NRPostProc NREUnwind_callback;
static Tcl_ObjCmdProc TestNREUnwind;
static Tcl_ObjCmdProc TestNRELevels;
static Tcl_ObjCmdProc TestInterpResolverCmd;
-#if defined(HAVE_CPUID)
+#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
static Tcl_ObjCmdProc TestcpuidCmd;
#endif
@@ -438,10 +440,84 @@ static const Tcl_Filesystem simpleFilesystem = {
*----------------------------------------------------------------------
*/
+#ifndef STRINGIFY
+# define STRINGIFY(x) STRINGIFY1(x)
+# define STRINGIFY1(x) #x
+#endif
+
+static const char version[] = TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID)
+#if defined(__clang__) && defined(__clang_major__)
+ ".clang-" STRINGIFY(__clang_major__)
+#if __clang_minor__ < 10
+ "0"
+#endif
+ STRINGIFY(__clang_minor__)
+#endif
+#ifdef TCL_COMPILE_DEBUG
+ ".compiledebug"
+#endif
+#ifdef TCL_COMPILE_STATS
+ ".compilestats"
+#endif
+#if defined(__cplusplus) && !defined(__OBJC__)
+ ".cplusplus"
+#endif
+#ifndef NDEBUG
+ ".debug"
+#endif
+#if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__)
+ ".gcc-" STRINGIFY(__GNUC__)
+#if __GNUC_MINOR__ < 10
+ "0"
+#endif
+ STRINGIFY(__GNUC_MINOR__)
+#endif
+#ifdef __INTEL_COMPILER
+ ".icc-" STRINGIFY(__INTEL_COMPILER)
+#endif
+#if (defined(_WIN32) && !defined(_WIN64)) || (ULONG_MAX == 0xffffffffUL)
+ ".ilp32"
+#endif
+#ifdef TCL_MEM_DEBUG
+ ".memdebug"
+#endif
+#if defined(_MSC_VER)
+ ".msvc-" STRINGIFY(_MSC_VER)
+#endif
+#ifdef USE_NMAKE
+ ".nmake"
+#endif
+#if !TCL_THREADS
+ ".no-thread"
+#endif
+#ifndef TCL_CFG_OPTIMIZED
+ ".no-optimize"
+#endif
+#ifdef __OBJC__
+ ".objective-c"
+#if defined(__cplusplus)
+ "plusplus"
+#endif
+#endif
+#ifdef TCL_CFG_PROFILED
+ ".profile"
+#endif
+#ifdef PURIFY
+ ".purify"
+#endif
+#ifdef STATIC_BUILD
+ ".static"
+#endif
+#if TCL_UTF_MAX < 4
+ ".utf-16"
+#endif
+;
+
int
Tcltest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
+ Tcl_CmdInfo info;
Tcl_Obj **objv, *objPtr;
int objc, index;
static const char *const specialOptions[] = {
@@ -460,8 +536,11 @@ Tcltest_Init(
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
- /* TIP #268: Full patchlevel instead of just major.minor */
+ if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
+ Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
+ info.objProc, (void *)version, NULL);
+ }
if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -616,7 +695,7 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
-#if defined(HAVE_CPUID)
+#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
NULL, NULL);
#endif
@@ -706,9 +785,18 @@ int
Tcltest_SafeInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
+ Tcl_CmdInfo info;
+
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
+ if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
+ Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
+ info.objProc, (void *)version, NULL);
+ }
+ if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
return Procbodytest_SafeInit(interp);
}
@@ -760,7 +848,7 @@ TestasyncCmd(
asyncPtr->nextPtr = firstHandler;
firstHandler = asyncPtr;
Tcl_MutexUnlock(&asyncTestMutex);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(asyncPtr->id));
} else if (strcmp(argv[1], "delete") == 0) {
if (argc == 2) {
Tcl_MutexLock(&asyncTestMutex);
@@ -1023,9 +1111,9 @@ TestcmdinfoCmd(
info.deleteProc = CmdDelProc2;
info.deleteData = (void *) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
}
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
@@ -1676,7 +1764,7 @@ TestdoubledigitsObjCmd(
strObj = Tcl_NewStringObj(str, endPtr-str);
ckfree(str);
retval = Tcl_NewListObj(1, &strObj);
- Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt));
+ Tcl_ListObjAppendElement(NULL, retval, Tcl_NewWideIntObj(decpt));
strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
Tcl_ListObjAppendElement(NULL, retval, strObj);
Tcl_SetObjResult(interp, retval);
@@ -1770,7 +1858,7 @@ TestdstringCmd(
if (argc != 2) {
goto wrongNumArgs;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_DStringLength(&dstring)));
} else if (strcmp(argv[1], "result") == 0) {
if (argc != 2) {
goto wrongNumArgs;
@@ -3534,7 +3622,7 @@ PrintParse(
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewIntObj(parsePtr->numWords));
+ Tcl_NewWideIntObj(parsePtr->numWords));
for (i = 0; i < parsePtr->numTokens; i++) {
tokenPtr = &parsePtr->tokenPtr[i];
switch (tokenPtr->type) {
@@ -3574,7 +3662,7 @@ PrintParse(
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewIntObj(tokenPtr->numComponents));
+ Tcl_NewWideIntObj(tokenPtr->numComponents));
}
Tcl_ListObjAppendElement(NULL, objPtr,
parsePtr->commandStart ?
@@ -3890,7 +3978,7 @@ TestregexpObjCmd(
* value 0.
*/
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), 0);
if (objc > 2 && (cflags&REG_EXPECT) && indices) {
const char *varName;
const char *value;
@@ -3986,7 +4074,7 @@ TestregexpObjCmd(
* Set the interpreter's object result to an integer object w/ value 1.
*/
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), 1);
return TCL_OK;
}
@@ -6203,7 +6291,7 @@ TestServiceModeCmd(
Tcl_SetServiceMode(TCL_SERVICE_ALL);
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(oldmode));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(oldmode));
return TCL_OK;
}
@@ -6881,7 +6969,7 @@ TestUtfNextCmd(
int objc,
Tcl_Obj *const objv[])
{
- int numBytes;
+ size_t numBytes;
char *bytes;
const char *result, *first;
char buffer[32];
@@ -6894,10 +6982,10 @@ TestUtfNextCmd(
}
bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
- if (numBytes > (int)sizeof(buffer) - 4) {
+ if (numBytes + 4 > sizeof(buffer)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "\"testutfnext\" can only handle %d bytes",
- (int)sizeof(buffer) - 4));
+ "\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
+ sizeof(buffer) - 4));
return TCL_ERROR;
}
@@ -6925,7 +7013,7 @@ TestUtfNextCmd(
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(first - buffer - 1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(first - buffer - 1));
return TCL_OK;
}
@@ -6967,7 +7055,7 @@ TestUtfPrevCmd(
offset = numBytes;
}
result = Tcl_UtfPrev(bytes + offset, bytes);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result - bytes));
return TCL_OK;
}
@@ -6995,7 +7083,7 @@ TestNumUtfCharsCmd(
}
}
len = Tcl_NumUtfChars(bytes, limit);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(len));
}
return TCL_OK;
}
@@ -7071,7 +7159,7 @@ TestGetIntForIndexCmd(
-#if defined(HAVE_CPUID)
+#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
/*
*----------------------------------------------------------------------
*
@@ -7120,7 +7208,7 @@ TestcpuidCmd(
return status;
}
for (i=0 ; i<4 ; ++i) {
- regsObjs[i] = Tcl_NewIntObj(regs[i]);
+ regsObjs[i] = Tcl_NewWideIntObj(regs[i]);
}
Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
return TCL_OK;
@@ -7161,7 +7249,7 @@ TestHashSystemHashCmd(
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
@@ -7178,13 +7266,13 @@ TestHashSystemHashCmd(
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
if (hPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
@@ -7226,7 +7314,7 @@ TestgetintCmd(
}
total += val;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
return TCL_OK;
}
}
@@ -7245,7 +7333,7 @@ TestlongsizeCmd(
Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(long)));
return TCL_OK;
}
@@ -7268,9 +7356,9 @@ NREUnwind_callback(
&none, NULL);
} else {
Tcl_Obj *idata[3];
- idata[0] = Tcl_NewIntObj((int) ((char *) data[1] - (char *) data[0]));
- idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0]));
- idata[2] = Tcl_NewIntObj((int) ((char *) &none - (char *) data[0]));
+ idata[0] = Tcl_NewWideIntObj((int) ((char *) data[1] - (char *) data[0]));
+ idata[1] = Tcl_NewWideIntObj((int) ((char *) data[2] - (char *) data[0]));
+ idata[2] = Tcl_NewWideIntObj((int) ((char *) &none - (char *) data[0]));
Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
}
return TCL_OK;
@@ -7314,18 +7402,18 @@ TestNRELevels(
depth = (refDepth - &depth);
- levels[0] = Tcl_NewIntObj(depth);
- levels[1] = Tcl_NewIntObj(iPtr->numLevels);
- levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level);
- levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level);
- levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
+ levels[0] = Tcl_NewWideIntObj(depth);
+ levels[1] = Tcl_NewWideIntObj(iPtr->numLevels);
+ levels[2] = Tcl_NewWideIntObj(iPtr->cmdFramePtr->level);
+ levels[3] = Tcl_NewWideIntObj(iPtr->varFramePtr->level);
+ levels[4] = Tcl_NewWideIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
- iPtr->execEnvPtr->execStackPtr->stackWords);
while (cbPtr) {
i++;
cbPtr = cbPtr->nextPtr;
}
- levels[5] = Tcl_NewIntObj(i);
+ levels[5] = Tcl_NewWideIntObj(i);
Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
return TCL_OK;
@@ -7726,8 +7814,8 @@ TestparseargsCmd(
if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
return TCL_ERROR;
}
- result[0] = Tcl_NewIntObj(foo);
- result[1] = Tcl_NewIntObj(count);
+ result[0] = Tcl_NewWideIntObj(foo);
+ result[1] = Tcl_NewWideIntObj(count);
result[2] = Tcl_NewListObj(count, remObjv);
Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
ckfree(remObjv);
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index f766030..a235002 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -38,10 +38,10 @@
* Forward declarations for functions defined later in this file:
*/
-static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
+static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex);
static int GetVariableIndex(Tcl_Interp *interp,
- const char *string, int *indexPtr);
-static void SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr);
+ Tcl_Obj *obj, size_t *indexPtr);
+static void SetVarToObj(Tcl_Obj **varPtr, size_t varIndex, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc TestbignumobjCmd;
static Tcl_ObjCmdProc TestbooleanobjCmd;
static Tcl_ObjCmdProc TestdoubleobjCmd;
@@ -160,7 +160,8 @@ TestbignumobjCmd(
BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
BIGNUM_RADIXSIZE
};
- int index, varIndex;
+ int index;
+ size_t varIndex;
const char *string;
mp_int bignumValue;
Tcl_Obj **varPtr;
@@ -173,13 +174,12 @@ TestbignumobjCmd(
&index) != TCL_OK) {
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
- switch (index) {
+ switch ((enum options)index) {
case BIGNUM_SET:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "var value");
@@ -292,9 +292,9 @@ TestbignumobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], mp_iszero(&bignumValue));
+ Tcl_SetWideIntObj(varPtr[varIndex], mp_iszero(&bignumValue));
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iszero(&bignumValue)));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(mp_iszero(&bignumValue)));
}
mp_clear(&bignumValue);
break;
@@ -315,9 +315,9 @@ TestbignumobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], index);
+ Tcl_SetWideIntObj(varPtr[varIndex], index);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(index));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(index));
}
mp_clear(&bignumValue);
break;
@@ -352,8 +352,9 @@ TestbooleanobjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int varIndex, boolValue;
- const char *index, *subCmd;
+ size_t varIndex;
+ int boolValue;
+ const char *subCmd;
Tcl_Obj **varPtr;
if (objc < 3) {
@@ -362,8 +363,7 @@ TestbooleanobjCmd(
return TCL_ERROR;
}
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -452,9 +452,9 @@ TestdoubleobjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int varIndex;
+ size_t varIndex;
double doubleValue;
- const char *index, *subCmd, *string;
+ const char *subCmd;
Tcl_Obj **varPtr;
if (objc < 3) {
@@ -465,8 +465,7 @@ TestdoubleobjCmd(
varPtr = GetVarPtr(interp);
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -475,8 +474,7 @@ TestdoubleobjCmd(
if (objc != 4) {
goto wrongNumArgs;
}
- string = Tcl_GetString(objv[3]);
- if (Tcl_GetDouble(interp, string, &doubleValue) != TCL_OK) {
+ if (Tcl_GetDouble(interp, Tcl_GetString(objv[3]), &doubleValue) != TCL_OK) {
return TCL_ERROR;
}
@@ -570,7 +568,8 @@ TestindexobjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int allowAbbrev, index, index2, setError, i, result;
+ int allowAbbrev, index, setError, i, result;
+ Tcl_WideInt index2;
const char **argv;
static const char *const tablePtr[] = {"a", "b", "check", NULL};
@@ -579,10 +578,9 @@ TestindexobjCmd(
*/
struct IndexRep {
void *tablePtr; /* Pointer to the table of strings. */
- int offset; /* Offset between table entries. */
- int index; /* Selected index into table. */
- };
- struct IndexRep *indexRep;
+ TCL_HASH_TYPE offset; /* Offset between table entries. */
+ TCL_HASH_TYPE index; /* Selected index into table. */
+ } *indexRep;
if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
"check") == 0)) {
@@ -592,7 +590,7 @@ TestindexobjCmd(
* lookups.
*/
- if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &index2) != TCL_OK) {
return TCL_ERROR;
}
@@ -602,7 +600,7 @@ TestindexobjCmd(
result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
}
return result;
}
@@ -630,7 +628,7 @@ TestindexobjCmd(
&index);
ckfree(argv);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
}
return result;
}
@@ -660,9 +658,12 @@ TestintobjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int intValue, varIndex, i;
+ size_t varIndex;
+#if (INT_MAX != LONG_MAX) /* int is not the same size as long */
+ int i;
+#endif
Tcl_WideInt wideValue;
- const char *index, *subCmd, *string;
+ const char *subCmd;
Tcl_Obj **varPtr;
if (objc < 3) {
@@ -672,8 +673,7 @@ TestintobjCmd(
}
varPtr = GetVarPtr(interp);
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -682,11 +682,9 @@ TestintobjCmd(
if (objc != 4) {
goto wrongNumArgs;
}
- string = Tcl_GetString(objv[3]);
- if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &wideValue) != TCL_OK) {
return TCL_ERROR;
}
- intValue = i;
/*
* If the object currently bound to the variable with index varIndex
@@ -697,38 +695,34 @@ TestintobjCmd(
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], intValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], wideValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
if (objc != 4) {
goto wrongNumArgs;
}
- string = Tcl_GetString(objv[3]);
- if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &wideValue) != TCL_OK) {
return TCL_ERROR;
}
- intValue = i;
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], intValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], wideValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue));
}
} else if (strcmp(subCmd, "setint") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
- string = Tcl_GetString(objv[3]);
- if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &wideValue) != TCL_OK) {
return TCL_ERROR;
}
- intValue = i;
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetWideIntObj(varPtr[varIndex], intValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], wideValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "setmax") == 0) {
@@ -768,8 +762,7 @@ TestintobjCmd(
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- string = Tcl_GetString(varPtr[varIndex]);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), -1);
} else if (strcmp(subCmd, "inttoobigtest") == 0) {
/*
* If long ints have more bits than ints on this platform, verify that
@@ -803,14 +796,14 @@ TestintobjCmd(
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
- &intValue) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex],
+ &wideValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], intValue * 10);
+ Tcl_SetWideIntObj(varPtr[varIndex], wideValue * 10);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue * 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
@@ -820,14 +813,14 @@ TestintobjCmd(
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
- &intValue) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex],
+ &wideValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], intValue / 10);
+ Tcl_SetWideIntObj(varPtr[varIndex], wideValue / 10);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue / 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -874,13 +867,11 @@ TestlistobjCmd(
LISTOBJ_SET,
LISTOBJ_GET,
LISTOBJ_REPLACE
- };
+ } cmdIndex;
- const char* index; /* Argument giving the variable number */
- int varIndex; /* Variable number converted to binary */
- int cmdIndex; /* Ordinal number of the subcommand */
- int first; /* First index in the list */
- int count; /* Count of elements in a list */
+ size_t varIndex; /* Variable number converted to binary */
+ Tcl_WideInt first; /* First index in the list */
+ Tcl_WideInt count; /* Count of elements in a list */
Tcl_Obj **varPtr;
if (objc < 3) {
@@ -888,8 +879,7 @@ TestlistobjCmd(
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
@@ -923,8 +913,8 @@ TestlistobjCmd(
"varIndex start count ?element...?");
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK
- || Tcl_GetIntFromObj(interp, objv[4], &count) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK
+ || Tcl_GetWideIntFromObj(interp, objv[4], &count) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_IsShared(varPtr[varIndex])) {
@@ -961,8 +951,9 @@ TestobjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int varIndex, destIndex, i;
- const char *index, *subCmd, *string;
+ size_t varIndex, destIndex;
+ int i;
+ const char *subCmd;
const Tcl_ObjType *targetType;
Tcl_Obj **varPtr;
@@ -978,15 +969,13 @@ TestobjCmd(
if (objc != 4) {
goto wrongNumArgs;
}
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- string = Tcl_GetString(objv[3]);
- if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[3], &destIndex) != TCL_OK) {
return TCL_ERROR;
}
SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
@@ -996,29 +985,26 @@ TestobjCmd(
if (objc != 2) {
goto wrongNumArgs;
}
- elemObjPtr = Tcl_NewIntObj(123);
+ elemObjPtr = Tcl_NewWideIntObj(123);
listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
/* Replace the single list element through itself, nonsense but legal. */
Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
} else if (strcmp(subCmd, "convert") == 0) {
- const char *typeName;
if (objc != 4) {
goto wrongNumArgs;
}
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- typeName = Tcl_GetString(objv[3]);
- if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
+ if ((targetType = Tcl_GetObjType(Tcl_GetString(objv[3]))) == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "no type ", typeName, " found", NULL);
+ "no type ", Tcl_GetString(objv[3]), " found", NULL);
return TCL_ERROR;
}
if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
@@ -1030,15 +1016,13 @@ TestobjCmd(
if (objc != 4) {
goto wrongNumArgs;
}
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- string = Tcl_GetString(objv[3]);
- if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[3], &destIndex) != TCL_OK) {
return TCL_ERROR;
}
SetVarToObj(varPtr, destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
@@ -1057,8 +1041,7 @@ TestobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
@@ -1070,8 +1053,7 @@ TestobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
SetVarToObj(varPtr, varIndex, Tcl_NewObj());
@@ -1100,8 +1082,7 @@ TestobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
@@ -1112,8 +1093,7 @@ TestobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
@@ -1174,10 +1154,11 @@ TeststringobjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *unicode;
- int varIndex, option, i, length;
- int size;
+ size_t varIndex;
+ int size, option, i;
+ Tcl_WideInt length;
#define MAX_STRINGS 11
- const char *index, *string, *strings[MAX_STRINGS+1];
+ const char *string, *strings[MAX_STRINGS+1];
String *strPtr;
Tcl_Obj **varPtr;
static const char *const options[] = {
@@ -1193,8 +1174,7 @@ TeststringobjCmd(
}
varPtr = GetVarPtr(interp);
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -1207,7 +1187,7 @@ TeststringobjCmd(
if (objc != 5) {
goto wrongNumArgs;
}
- if (Tcl_GetIntFromObj(interp, objv[4], &length) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[4], &length) != TCL_OK) {
return TCL_ERROR;
}
if (varPtr[varIndex] == NULL) {
@@ -1222,8 +1202,7 @@ TeststringobjCmd(
if (Tcl_IsShared(varPtr[varIndex])) {
SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
- string = Tcl_GetString(objv[3]);
- Tcl_AppendToObj(varPtr[varIndex], string, length);
+ Tcl_AppendToObj(varPtr[varIndex], Tcl_GetString(objv[3]), length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
case 1: /* appendstrings */
@@ -1270,14 +1249,13 @@ TeststringobjCmd(
if (CheckIfVarUnset(interp, varPtr, varIndex)) {
return TCL_ERROR;
}
- string = Tcl_GetString(varPtr[varIndex]);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), -1);
break;
case 4: /* length */
if (objc != 3) {
goto wrongNumArgs;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
? varPtr[varIndex]->length : -1);
break;
case 5: /* length2 */
@@ -1292,7 +1270,7 @@ TeststringobjCmd(
} else {
length = -1;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
break;
case 6: /* set */
if (objc != 4) {
@@ -1327,7 +1305,7 @@ TeststringobjCmd(
if (objc != 4) {
goto wrongNumArgs;
}
- if (Tcl_GetIntFromObj(interp, objv[3], &length) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
return TCL_ERROR;
}
if (varPtr[varIndex] != NULL) {
@@ -1346,7 +1324,7 @@ TeststringobjCmd(
} else {
length = -1;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
break;
case 10: /* appendself */
if (objc != 4) {
@@ -1367,16 +1345,16 @@ TeststringobjCmd(
string = Tcl_GetStringFromObj(varPtr[varIndex], &size);
- if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
return TCL_ERROR;
}
- if ((i < 0) || (i > size)) {
+ if ((length < 0) || (length > size)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"index value out of range", -1));
return TCL_ERROR;
}
- Tcl_AppendToObj(varPtr[varIndex], string + i, size - i);
+ Tcl_AppendToObj(varPtr[varIndex], string + length, size - length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
case 11: /* appendself2 */
@@ -1398,16 +1376,16 @@ TeststringobjCmd(
unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size);
- if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
return TCL_ERROR;
}
- if ((i < 0) || (i > size)) {
+ if ((length < 0) || (length > size)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"index value out of range", -1));
return TCL_ERROR;
}
- Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, size - i);
+ Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
}
@@ -1437,7 +1415,7 @@ TeststringobjCmd(
static void
SetVarToObj(
Tcl_Obj **varPtr,
- int varIndex, /* Designates the assignment variable. */
+ size_t varIndex, /* Designates the assignment variable. */
Tcl_Obj *objPtr) /* Points to object to assign to var. */
{
if (varPtr[varIndex] != NULL) {
@@ -1468,14 +1446,14 @@ SetVarToObj(
static int
GetVariableIndex(
Tcl_Interp *interp, /* Interpreter for error reporting. */
- const char *string, /* String containing a variable index
+ Tcl_Obj *obj, /* The variable index
* specified as a nonnegative number less than
* NUMBER_OF_OBJECT_VARS. */
- int *indexPtr) /* Place to store converted result. */
+ size_t *indexPtr) /* Place to store converted result. */
{
- int index;
+ Tcl_WideInt index;
- if (Tcl_GetInt(interp, string, &index) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, obj, &index) != TCL_OK) {
return TCL_ERROR;
}
if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) {
@@ -1510,12 +1488,12 @@ static int
CheckIfVarUnset(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tcl_Obj ** varPtr,
- int varIndex) /* Index of the test variable to check. */
+ size_t varIndex) /* Index of the test variable to check. */
{
if (varPtr[varIndex] == NULL) {
char buf[32 + TCL_INTEGER_SPACE];
- sprintf(buf, "variable %d is unset (NULL)", varIndex);
+ sprintf(buf, "variable %" TCL_Z_MODIFIER "u is unset (NULL)", varIndex);
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
return 1;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 5a59fde..6d948dd 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -200,7 +200,7 @@ static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp,
int flags);
static int ObjMakeUpvar(Tcl_Interp *interp,
CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
- const char *otherP2, const int otherFlags,
+ const char *otherP2, int otherFlags,
Tcl_Obj *myNamePtr, int myFlags, int index);
static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
@@ -224,7 +224,7 @@ static void SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);
*/
MODULE_SCOPE Var * TclLookupSimpleVar(Tcl_Interp *interp,
- Tcl_Obj *varNamePtr, int flags, const int create,
+ Tcl_Obj *varNamePtr, int flags, int create,
const char **errMsgPtr, int *indexPtr);
static Tcl_DupInternalRepProc DupLocalVarName;
@@ -541,10 +541,10 @@ TclObjLookupVar(
const char *msg, /* Verb to use in error messages, e.g. "read"
* or "set". Only needed if TCL_LEAVE_ERR_MSG
* is set in flags. */
- const int createPart1, /* If 1, create hash table entry for part 1 of
+ int createPart1, /* If 1, create hash table entry for part 1 of
* name, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
- const int createPart2, /* If 1, create hash table entry for part 2 of
+ int createPart2, /* If 1, create hash table entry for part 2 of
* name, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
Var **arrayPtrPtr) /* If the name refers to an element of an
@@ -591,10 +591,10 @@ TclObjLookupVarEx(
const char *msg, /* Verb to use in error messages, e.g. "read"
* or "set". Only needed if TCL_LEAVE_ERR_MSG
* is set in flags. */
- const int createPart1, /* If 1, create hash table entry for part 1 of
+ int createPart1, /* If 1, create hash table entry for part 1 of
* name, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
- const int createPart2, /* If 1, create hash table entry for part 2 of
+ int createPart2, /* If 1, create hash table entry for part 2 of
* name, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
Var **arrayPtrPtr) /* If the name refers to an element of an
@@ -827,7 +827,7 @@ TclLookupSimpleVar(
int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG
* bits matter. */
- const int create, /* If 1, create hash table entry for varname,
+ int create, /* If 1, create hash table entry for varname,
* if it doesn't already exist. If 0, return
* error if it doesn't exist. */
const char **errMsgPtr,
@@ -1062,15 +1062,15 @@ TclLookupArrayElement(
Tcl_Obj *arrayNamePtr, /* This is the name of the array, or NULL if
* index>= 0. */
Tcl_Obj *elNamePtr, /* Name of element within array. */
- const int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */
+ int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */
const char *msg, /* Verb to use in error messages, e.g. "read"
* or "set". Only needed if TCL_LEAVE_ERR_MSG
* is set in flags. */
- const int createArray, /* If 1, transform arrayName to be an array if
+ int createArray, /* If 1, transform arrayName to be an array if
* it isn't one yet and the transformation is
* possible. If 0, return error if it isn't
* already an array. */
- const int createElem, /* If 1, create hash table entry for the
+ int createElem, /* If 1, create hash table entry for the
* element, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
Var *arrayPtr, /* Pointer to the array's Var structure. */
@@ -1383,7 +1383,7 @@ TclPtrGetVar(
* the name of a variable. */
Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
* in the array part1. */
- const int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and
+ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
{
if (varPtr == NULL) {
@@ -1429,7 +1429,7 @@ TclPtrGetVarIdx(
* the name of a variable. */
Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
* in the array part1. */
- const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and
+ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
int index) /* Index into the local variable table of the
* variable, or -1. Only used when part1Ptr is
@@ -1822,7 +1822,7 @@ TclPtrSetVar(
Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
* in the array part1. */
Tcl_Obj *newValuePtr, /* New value for variable. */
- const int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and
+ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
{
if (varPtr == NULL) {
@@ -2001,7 +2001,7 @@ TclPtrSetVarIdx(
Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
* in the array part1. */
Tcl_Obj *newValuePtr, /* New value for variable. */
- const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and
+ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
int index) /* Index of local var where part1 is to be
* found. */
@@ -2247,7 +2247,7 @@ TclPtrIncrObjVar(
* part1Ptr. */
Tcl_Obj *incrPtr, /* Increment value. */
/* TODO: Which of these flag values really make sense? */
- const int flags) /* Various flags that tell how to incr value:
+ int flags) /* Various flags that tell how to incr value:
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
* TCL_LEAVE_ERR_MSG. */
@@ -2303,7 +2303,7 @@ TclPtrIncrObjVarIdx(
* part1Ptr. */
Tcl_Obj *incrPtr, /* Increment value. */
/* TODO: Which of these flag values really make sense? */
- const int flags, /* Various flags that tell how to incr value:
+ int flags, /* Various flags that tell how to incr value:
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
* TCL_LEAVE_ERR_MSG. */
@@ -2532,7 +2532,7 @@ TclPtrUnsetVar(
* the name of a variable. */
Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
* in the array part1. */
- const int flags) /* OR-ed combination of any of
+ int flags) /* OR-ed combination of any of
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_LEAVE_ERR_MSG. */
{
@@ -2579,7 +2579,7 @@ TclPtrUnsetVarIdx(
* the name of a variable. */
Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
* in the array part1. */
- const int flags, /* OR-ed combination of any of
+ int flags, /* OR-ed combination of any of
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_LEAVE_ERR_MSG. */
int index) /* Index into the local variable table of the
@@ -4373,7 +4373,7 @@ ArrayUnsetCmd(
Tcl_Obj *varNameObj, *patternObj, *nameObj;
Tcl_HashSearch search;
const char *pattern;
- const int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */
+ int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */
int isArray;
switch (objc) {
@@ -4552,7 +4552,7 @@ ObjMakeUpvar(
* NULL means use global :: context. */
Tcl_Obj *otherP1Ptr,
const char *otherP2, /* Two-part name of variable in framePtr. */
- const int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+ int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
* indicates scope of "other" variable. */
Tcl_Obj *myNamePtr, /* Name of variable which will refer to
* otherP1/otherP2. Must be a scalar. */
diff --git a/tests/string.test b/tests/string.test
index 7da50e9..203d0c6 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -510,6 +510,9 @@ test string-5.20.$noComp {string index, bytearray object out of bounds} -body {
test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -body {
run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
} -result [list \U100000 {} b]
+test string-5.22.$noComp {string index} -constraints testbytestring -body {
+ run {list [scan [string index [testbytestring \xFF] 0] %c var] $var}
+} -result {1 255}
test string-6.1.$noComp {string is, not enough args} {
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index 020aad9..75ed97e 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -682,7 +682,7 @@ array set exclude_refs_map {
ttk_scale.n {variable}
ttk_scrollbar.n {set}
ttk_spinbox.n {format}
- ttk_treeview.n {text open}
+ ttk_treeview.n {text open focus selection}
ttk_widget.n {image text variable}
TclZlib.3 {binary flush filename text}
}
diff --git a/unix/config.status.lineno b/unix/config.status.lineno
index 12d4f40..f252363 100755
--- a/unix/config.status.lineno
+++ b/unix/config.status.lineno
@@ -472,7 +472,7 @@ s,@mandir@,${prefix}/man,;t t
s,@build_alias@,,;t t
s,@host_alias@,,;t t
s,@target_alias@,,;t t
-s,@DEFS@,-DPACKAGE_NAME=\"tcl\" -DPACKAGE_TARNAME=\"tcl\" -DPACKAGE_VERSION=\"8.6\" -DPACKAGE_STRING=\"tcl\ 8.6\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_PTHREAD_ATFORK=1 -DTCL_THREADS=1 -DTCL_CFGVAL_ENCODING=\"iso8859-1\" -DHAVE_ZLIB=1 -DMODULE_SCOPE=extern\ __attribute__\(\(__visibility__\(\"hidden\"\)\)\) -DHAVE_HIDDEN=1 -DHAVE_CAST_TO_UNION=1 -DTCL_SHLIB_EXT=\".so\" -DNDEBUG=1 -DTCL_CFG_OPTIMIZED=1 -DTCL_TOMMATH=1 -DMP_PREC=4 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_IS_LONG=1 -DHAVE_GETCWD=1 -DHAVE_MKSTEMP=1 -DHAVE_OPENDIR=1 -DHAVE_STRTOL=1 -DHAVE_WAITPID=1 -DHAVE_GETNAMEINFO=1 -DHAVE_GETADDRINFO=1 -DHAVE_FREEADDRINFO=1 -DHAVE_GAI_STRERROR=1 -DHAVE_STRUCT_ADDRINFO=1 -DHAVE_STRUCT_IN6_ADDR=1 -DHAVE_STRUCT_SOCKADDR_IN6=1 -DHAVE_STRUCT_SOCKADDR_STORAGE=1 -DHAVE_GETPWUID_R_5=1 -DHAVE_GETPWUID_R=1 -DHAVE_GETPWNAM_R_5=1 -DHAVE_GETPWNAM_R=1 -DHAVE_GETGRGID_R_5=1 -DHAVE_GETGRGID_R=1 -DHAVE_GETGRNAM_R_5=1 -DHAVE_GETGRNAM_R=1 -DHAVE_GETHOSTBYNAME_R_6=1 -DHAVE_GETHOSTBYNAME_R=1 -DHAVE_GETHOSTBYADDR_R_8=1 -DHAVE_GETHOSTBYADDR_R=1 -DHAVE_TERMIOS_H=1 -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_MKTIME=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_STRUCT_STAT_ST_BLOCKS=1 -DHAVE_STRUCT_STAT_ST_BLKSIZE=1 -DHAVE_BLKCNT_T=1 -DHAVE_INTPTR_T=1 -DHAVE_UINTPTR_T=1 -DNO_UNION_WAIT=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DHAVE_MKSTEMPS=1 -DHAVE_FTS=1 -DHAVE_SYS_IOCTL_H=1 -DTCL_UNLOAD_DLLS=1 -DHAVE_CPUID=1 ,;t t
+s,@DEFS@,-DPACKAGE_NAME=\"tcl\" -DPACKAGE_TARNAME=\"tcl\" -DPACKAGE_VERSION=\"8.6\" -DPACKAGE_STRING=\"tcl\ 8.6\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_PTHREAD_ATFORK=1 -DTCL_THREADS=1 -DTCL_CFGVAL_ENCODING=\"iso8859-1\" -DHAVE_ZLIB=1 -DMODULE_SCOPE=extern\ __attribute__\(\(__visibility__\(\"hidden\"\)\)\) -DHAVE_HIDDEN=1 -DHAVE_CAST_TO_UNION=1 -DTCL_SHLIB_EXT=\".so\" -DNDEBUG=1 -DTCL_CFG_OPTIMIZED=1 -DTCL_TOMMATH=1 -DMP_PREC=4 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_IS_LONG=1 -DHAVE_GETCWD=1 -DHAVE_MKSTEMP=1 -DHAVE_OPENDIR=1 -DHAVE_STRTOL=1 -DHAVE_WAITPID=1 -DHAVE_GETNAMEINFO=1 -DHAVE_GETADDRINFO=1 -DHAVE_FREEADDRINFO=1 -DHAVE_GAI_STRERROR=1 -DHAVE_STRUCT_ADDRINFO=1 -DHAVE_STRUCT_IN6_ADDR=1 -DHAVE_STRUCT_SOCKADDR_IN6=1 -DHAVE_STRUCT_SOCKADDR_STORAGE=1 -DHAVE_GETPWUID_R_5=1 -DHAVE_GETPWUID_R=1 -DHAVE_GETPWNAM_R_5=1 -DHAVE_GETPWNAM_R=1 -DHAVE_GETGRGID_R_5=1 -DHAVE_GETGRGID_R=1 -DHAVE_GETGRNAM_R_5=1 -DHAVE_GETGRNAM_R=1 -DHAVE_DECL_GETHOSTBYNAME_R=1 -DHAVE_GETHOSTBYNAME_R_6=1 -DHAVE_GETHOSTBYNAME_R=1 -DHAVE_DECL_GETHOSTBYADDR_R=1 -DHAVE_GETHOSTBYADDR_R_8=1 -DHAVE_GETHOSTBYADDR_R=1 -DHAVE_TERMIOS_H=1 -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_MKTIME=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_STRUCT_STAT_ST_BLOCKS=1 -DHAVE_STRUCT_STAT_ST_BLKSIZE=1 -DHAVE_BLKCNT_T=1 -DHAVE_INTPTR_T=1 -DHAVE_UINTPTR_T=1 -DNO_UNION_WAIT=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DHAVE_MKSTEMPS=1 -DHAVE_FTS=1 -DHAVE_SYS_IOCTL_H=1 -DTCL_UNLOAD_DLLS=1 -DHAVE_CPUID=1 ,;t t
s,@ECHO_C@,,;t t
s,@ECHO_N@,-n,;t t
s,@ECHO_T@,,;t t
@@ -488,7 +488,7 @@ s,@OBJEXT@,o,;t t
s,@CPP@,gcc -E,;t t
s,@EGREP@,grep -E,;t t
s,@TCL_THREADS@,1,;t t
-s,@TCLSH_PROG@,/home/jima/space/ins/lin64/dynamic/main/bin/tclsh8.6,;t t
+s,@TCLSH_PROG@,/usr/bin/tclsh8.6,;t t
s,@ZLIB_OBJS@,,;t t
s,@ZLIB_SRCS@,,;t t
s,@ZLIB_INCLUDE@,,;t t
@@ -497,7 +497,7 @@ s,@ac_ct_RANLIB@,ranlib,;t t
s,@AR@,ar,;t t
s,@ac_ct_AR@,ar,;t t
s,@LIBOBJS@,,;t t
-s,@TCL_LIBS@,-ldl -lz -lpthread -lieee -lm,;t t
+s,@TCL_LIBS@,-ldl -lz -lpthread -lm,;t t
s,@DL_LIBS@,-ldl,;t t
s,@DL_OBJS@,tclLoadDl.o,;t t
s,@PLAT_OBJS@,,;t t
@@ -528,7 +528,7 @@ s,@DTRACE@,,;t t
s,@TCL_VERSION@,8.6,;t t
s,@TCL_MAJOR_VERSION@,8,;t t
s,@TCL_MINOR_VERSION@,6,;t t
-s,@TCL_PATCH_LEVEL@,.8,;t t
+s,@TCL_PATCH_LEVEL@,.10,;t t
s,@TCL_YEAR@,,;t t
s,@PKG_CFG_ARGS@,'--prefix=/home/jima/space/ins/lin64/dynamic/main' ,;t t
s,@TCL_LIB_FILE@,libtcl8.6.so,;t t
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 9e43c01..7bd840a 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -994,20 +994,19 @@ TclWinCPUID(
int status = TCL_ERROR;
/* See: <http://en.wikipedia.org/wiki/CPUID> */
-#if defined(HAVE_CPUID)
#if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64)
__asm__ __volatile__("movq %%rbx, %%rsi \n\t" /* save %rbx */
"cpuid \n\t"
"xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */
: "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
: "a"(index));
-#else
+ status = TCL_OK;
+#elif defined(__i386__) || defined(_M_IX86)
__asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */
"cpuid \n\t"
"xchg %%esi, %%ebx \n\t" /* restore the old %ebx */
: "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
: "a"(index));
-#endif
status = TCL_OK;
#else
(void)index;
diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c
index 0210cd3..45bda3e 100644
--- a/unix/tclXtNotify.c
+++ b/unix/tclXtNotify.c
@@ -181,7 +181,13 @@ TclSetAppContext(
void
InitNotifier(void)
{
- Tcl_NotifierProcs np;
+ static const Tcl_NotifierProcs np =
+ SetTimer,
+ WaitForEvent,
+ CreateFileHandler,
+ DeleteFileHandler,
+ NULL, NULL, NULL, NULL
+ };
/*
* Only reinitialize if we are not in exit handling. The notifier can get
@@ -193,11 +199,6 @@ InitNotifier(void)
return;
}
- memset(&np, 0, sizeof(np));
- np.createFileHandlerProc = CreateFileHandler;
- np.deleteFileHandlerProc = DeleteFileHandler;
- np.setTimerProc = SetTimer;
- np.waitForEventProc = WaitForEvent;
Tcl_SetNotifier(&np);
/*
diff --git a/win/makefile.vc b/win/makefile.vc
index 6b2a682..1ef64f2 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -819,7 +819,8 @@ $(TMP_DIR)\tclEvent.obj: $(GENERICDIR)\tclEvent.c $(TMP_DIR)\tclUuid.h
-Fo$@ $(GENERICDIR)\tclEvent.c
$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h
- $(cc32) $(appcflags) -I$(TMP_DIR) -Fo$@ $?
+ $(cc32) $(appcflags) -I$(TMP_DIR) \
+ -Fo$@ $(GENERICDIR)\tclTest.c
$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(cc32) $(appcflags) -Fo$@ $?
diff --git a/win/rules.vc b/win/rules.vc
index 372d70a..a571899 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -1471,8 +1471,8 @@ cdebug = $(cdebug) -Zi
!endif # $(DEBUG)
-# cwarn includes default warning levels.
-cwarn = $(WARNINGS)
+# cwarn includes default warning levels, also C4146 is useless.
+cwarn = $(WARNINGS) -wd4146
!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
# Disable pointer<->int warnings related to cast between different sizes
generated by cgit v0.12 at 2025-12-13 03:24:52 (GMT)