From 3e46af6402992817bf01c9e6bc423b4c3a2d5b82 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Apr 2020 10:07:03 +0000 Subject: Add (internal) stub entries for TclRegisterLiteral and TclStaticPackage. Not used in any test-cases yet, but could be used in extensions for testing. Backported from 8.6. New test commands "testbytestring" and "teststringbytes". Also backported from 8.6. Not used in any test-cases yet. --- generic/tclCompile.h | 2 - generic/tclInt.decls | 13 +- generic/tclIntDecls.h | 39 ++- generic/tclLiteral.c | 212 ++++++------ generic/tclStubInit.c | 8 +- generic/tclTest.c | 870 ++++++++++++++++++++++++-------------------------- 6 files changed, 593 insertions(+), 551 deletions(-) diff --git a/generic/tclCompile.h b/generic/tclCompile.h index ee994d7..9ee60c3 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -938,8 +938,6 @@ MODULE_SCOPE void TclPrintObject(FILE *outFile, Tcl_Obj *objPtr, int maxChars); MODULE_SCOPE void TclPrintSource(FILE *outFile, CONST char *string, int maxChars); -MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr, - char *bytes, int length, int flags); static inline void TclPreserveByteCode( diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 93a436a..892f977 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -945,7 +945,18 @@ declare 249 { int *decpt, int *signum, char **endPtr) } -declare 259 { +# Allow extensions for optimization +declare 251 { + int TclRegisterLiteral(void *envPtr, + char *bytes, int length, int flags) +} + +declare 257 { + void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, + Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) +} + +declare 260 { void TclUnusedStubEntry(void) } diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index fe23e77..4d98d00 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -1057,17 +1057,30 @@ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); #endif /* Slot 250 is reserved */ -/* Slot 251 is reserved */ +#ifndef TclRegisterLiteral_TCL_DECLARED +#define TclRegisterLiteral_TCL_DECLARED +/* 251 */ +EXTERN int TclRegisterLiteral(VOID *envPtr, char *bytes, + int length, int flags); +#endif /* Slot 252 is reserved */ /* Slot 253 is reserved */ /* Slot 254 is reserved */ /* Slot 255 is reserved */ /* Slot 256 is reserved */ -/* Slot 257 is reserved */ +#ifndef TclStaticPackage_TCL_DECLARED +#define TclStaticPackage_TCL_DECLARED +/* 257 */ +EXTERN void TclStaticPackage(Tcl_Interp *interp, + CONST char *pkgName, + Tcl_PackageInitProc *initProc, + Tcl_PackageInitProc *safeInitProc); +#endif /* Slot 258 is reserved */ +/* Slot 259 is reserved */ #ifndef TclUnusedStubEntry_TCL_DECLARED #define TclUnusedStubEntry_TCL_DECLARED -/* 259 */ +/* 260 */ EXTERN void TclUnusedStubEntry(void); #endif @@ -1326,15 +1339,16 @@ typedef struct TclIntStubs { VOID *reserved248; char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ VOID *reserved250; - VOID *reserved251; + int (*tclRegisterLiteral) (VOID *envPtr, char *bytes, int length, int flags); /* 251 */ VOID *reserved252; VOID *reserved253; VOID *reserved254; VOID *reserved255; VOID *reserved256; - VOID *reserved257; + void (*tclStaticPackage) (Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ VOID *reserved258; - void (*tclUnusedStubEntry) (void); /* 259 */ + VOID *reserved259; + void (*tclUnusedStubEntry) (void); /* 260 */ } TclIntStubs; extern TclIntStubs *tclIntStubsPtr; @@ -2065,17 +2079,24 @@ extern TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclDoubleDigits) /* 249 */ #endif /* Slot 250 is reserved */ -/* Slot 251 is reserved */ +#ifndef TclRegisterLiteral +#define TclRegisterLiteral \ + (tclIntStubsPtr->tclRegisterLiteral) /* 251 */ +#endif /* Slot 252 is reserved */ /* Slot 253 is reserved */ /* Slot 254 is reserved */ /* Slot 255 is reserved */ /* Slot 256 is reserved */ -/* Slot 257 is reserved */ +#ifndef TclStaticPackage +#define TclStaticPackage \ + (tclIntStubsPtr->tclStaticPackage) /* 257 */ +#endif /* Slot 258 is reserved */ +/* Slot 259 is reserved */ #ifndef TclUnusedStubEntry #define TclUnusedStubEntry \ - (tclIntStubsPtr->tclUnusedStubEntry) /* 259 */ + (tclIntStubsPtr->tclUnusedStubEntry) /* 260 */ #endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index b6c45ac..6aa6c5a 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -31,7 +31,7 @@ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); -static unsigned int HashString(const char *bytes, int length); +static unsigned HashString(const char *string, int length); #ifdef TCL_COMPILE_DEBUG static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -58,7 +58,7 @@ static void RebuildLiteralTable(LiteralTable *tablePtr); void TclInitLiteralTable( - register LiteralTable *tablePtr) + LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { @@ -131,7 +131,7 @@ TclDeleteLiteralTable( objPtr = entryPtr->objPtr; TclDecrRefCount(objPtr); nextPtr = entryPtr->nextPtr; - ckfree((char *) entryPtr); + ckfree((char *)entryPtr); entryPtr = nextPtr; } } @@ -141,7 +141,7 @@ TclDeleteLiteralTable( */ if (tablePtr->buckets != tablePtr->staticBuckets) { - ckfree((char *) tablePtr->buckets); + ckfree((char *)tablePtr->buckets); } } @@ -157,16 +157,16 @@ TclDeleteLiteralTable( * * Results: * The literal object. If it was created in this call *newPtr is set to - * 1, else 0. NULL is returned if newPtr==NULL and no literal is found. + * 1, else 0. NULL is returned if newPtr==NULL and no literal is found. * * Side effects: - * Increments the ref count of the global LiteralEntry since the caller - * now holds a reference. - * If LITERAL_ON_HEAP is set in flags, this function is given ownership - * of the string: if an object is created then its string representation - * is set directly from string, otherwise the string is freed. Typically, - * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated - * buffer holding the result of backslash substitutions. + * Increments the ref count of the global LiteralEntry since the caller + * now holds a reference. If LITERAL_ON_HEAP is set in flags, this + * function is given ownership of the string: if an object is created + * then its string representation is set directly from string, otherwise + * the string is freed. Typically, a caller sets LITERAL_ON_HEAP if + * "string" is an already heap-allocated buffer holding the result of + * backslash substitutions. * *---------------------------------------------------------------------- */ @@ -174,15 +174,17 @@ TclDeleteLiteralTable( Tcl_Obj * TclCreateLiteral( Interp *iPtr, - char *bytes, - int length, - unsigned int hash, /* The string's hash. If -1, it will be computed here */ + char *bytes, /* The start of the string. Note that this is + * not a NUL-terminated string. */ + int length, /* Number of bytes in the string. */ + unsigned hash, /* The string's hash. If -1, it will be + * computed here. */ int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr) { - LiteralTable *globalTablePtr = &(iPtr->literalTable); + LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; int globalHash; Tcl_Obj *objPtr; @@ -191,7 +193,7 @@ TclCreateLiteral( * Is it in the interpreter's global literal table? */ - if (hash == (unsigned int) -1) { + if (hash == (unsigned) -1) { hash = HashString(bytes, length); } globalHash = (hash & globalTablePtr->mask); @@ -231,7 +233,7 @@ TclCreateLiteral( } } if (!newPtr) { - if (flags & LITERAL_ON_HEAP) { + if ((flags & LITERAL_ON_HEAP)) { ckfree(bytes); } return NULL; @@ -244,7 +246,7 @@ TclCreateLiteral( TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); - if (flags & LITERAL_ON_HEAP) { + if ((flags & LITERAL_ON_HEAP)) { objPtr->bytes = bytes; objPtr->length = length; } else { @@ -253,12 +255,12 @@ TclCreateLiteral( #ifdef TCL_COMPILE_DEBUG if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { - Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be", - (length>60? 60 : length), bytes); + Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", + "TclRegisterLiteral", (length>60? 60 : length), bytes); } #endif - globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry)); + globalPtr = (LiteralEntry *)ckalloc(sizeof(LiteralEntry)); globalPtr->objPtr = objPtr; globalPtr->refCount = 1; globalPtr->nsPtr = nsPtr; @@ -291,8 +293,8 @@ TclCreateLiteral( } } if (!found) { - Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" wasn't global", - (length>60? 60 : length), bytes); + Tcl_Panic("%s: literal \"%.*s\" wasn't global", + "TclRegisterLiteral", (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -340,9 +342,9 @@ TclCreateLiteral( int TclRegisterLiteral( - CompileEnv *envPtr, /* Points to the CompileEnv in whose object + void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ - register char *bytes, /* Points to string for which to find or + char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ int length, /* Number of bytes in the string. If < 0, the @@ -351,14 +353,15 @@ TclRegisterLiteral( int flags) /* If LITERAL_ON_HEAP then the caller already * malloc'd bytes and ownership is passed to * this function. If LITERAL_NS_SCOPE then - * the literal shouldnot be shared accross + * the literal should not be shared accross * namespaces. */ { + CompileEnv *envPtr = ePtr; Interp *iPtr = envPtr->iPtr; - LiteralTable *localTablePtr = &(envPtr->localLitTable); + LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; - unsigned int hash; + unsigned hash; int localHash, objIndex, new; Namespace *nsPtr; @@ -379,7 +382,7 @@ TclRegisterLiteral( if ((objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { - if (flags & LITERAL_ON_HEAP) { + if ((flags & LITERAL_ON_HEAP)) { ckfree(bytes); } objIndex = (localPtr - envPtr->literalArrayPtr); @@ -444,14 +447,14 @@ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal + Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; - LiteralTable *globalTablePtr = &(iPtr->literalTable); - register LiteralEntry *entryPtr; - char *bytes; + LiteralTable *globalTablePtr = &iPtr->literalTable; + LiteralEntry *entryPtr; + const char *bytes; int length, globalHash; bytes = TclGetStringFromObj(objPtr, &length); @@ -490,18 +493,18 @@ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register CompileEnv *envPtr,/* Points to CompileEnv whose literal array + CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; - LiteralTable *localTablePtr = &(envPtr->localLitTable); + LiteralTable *localTablePtr = &envPtr->localLitTable; int localHash, length; - char *bytes; + const char *bytes; Tcl_Obj *newObjPtr; - lPtr = &(envPtr->literalArrayPtr[index]); + lPtr = &envPtr->literalArrayPtr[index]; /* * To avoid unwanted sharing we need to copy the object and remove it from @@ -553,14 +556,14 @@ TclHideLiteral( int TclAddLiteralObj( - register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The object to insert into the array. */ LiteralEntry **litPtrPtr) /* The location where the pointer to the new * literal entry should be stored. May be * NULL. */ { - register LiteralEntry *lPtr; + LiteralEntry *lPtr; int objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { @@ -569,7 +572,7 @@ TclAddLiteralObj( objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; - lPtr = &(envPtr->literalArrayPtr[objIndex]); + lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); lPtr->refCount = -1; /* i.e., unused */ @@ -595,19 +598,19 @@ TclAddLiteralObj( * * Side effects: * Expands the literal array if necessary. May rebuild the hash bucket - * array of the CompileEnv's literal array if it becomes too large. + * array of the CompileEnv's literal array if it becomes too large. * *---------------------------------------------------------------------- */ static int AddLocalLiteralEntry( - register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ - Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ + Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { - register LiteralTable *localTablePtr = &(envPtr->localLitTable); + LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; int objIndex; @@ -648,8 +651,8 @@ AddLocalLiteralEntry( if (!found) { bytes = Tcl_GetStringFromObj(objPtr, &length); - Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally", - (length>60? 60 : length), bytes); + Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", + "AddLocalLiteralEntry", (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -679,7 +682,7 @@ AddLocalLiteralEntry( static void ExpandLocalLiteralArray( - register CompileEnv *envPtr)/* Points to the CompileEnv whose object array + CompileEnv *envPtr)/* Points to the CompileEnv whose object array * must be enlarged. */ { /* @@ -687,7 +690,7 @@ ExpandLocalLiteralArray( * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ - LiteralTable *localTablePtr = &(envPtr->localLitTable); + LiteralTable *localTablePtr = &envPtr->localLitTable; int currElems = envPtr->literalArrayNext; size_t currBytes = (currElems * sizeof(LiteralEntry)); LiteralEntry *currArrayPtr = envPtr->literalArrayPtr; @@ -701,14 +704,15 @@ ExpandLocalLiteralArray( } if (envPtr->mallocedLiteralArray) { - newArrayPtr = (LiteralEntry *) ckrealloc( + newArrayPtr = (LiteralEntry *)ckrealloc( (char *)currArrayPtr, newSize); } else { /* * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must - * code a ckrealloc equivalent for ourselves + * code a ckrealloc equivalent for ourselves. */ - newArrayPtr = (LiteralEntry *) ckalloc(newSize); + + newArrayPtr = (LiteralEntry *)ckalloc(newSize); memcpy(newArrayPtr, currArrayPtr, currBytes); envPtr->mallocedLiteralArray = 1; } @@ -761,16 +765,21 @@ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register Tcl_Obj *objPtr) /* Points to a literal object that was + Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; - LiteralTable *globalTablePtr = &(iPtr->literalTable); - register LiteralEntry *entryPtr, *prevPtr; - char *bytes; + LiteralTable *globalTablePtr; + LiteralEntry *entryPtr, *prevPtr; + const char *bytes; int length, index; + if (iPtr == NULL) { + goto done; + } + + globalTablePtr = &iPtr->literalTable; bytes = TclGetStringFromObj(objPtr, &length); index = (HashString(bytes, length) & globalTablePtr->mask); @@ -797,7 +806,7 @@ TclReleaseLiteral( } else { prevPtr->nextPtr = entryPtr->nextPtr; } - ckfree((char *) entryPtr); + ckfree((char *)entryPtr); globalTablePtr->numEntries--; TclDecrRefCount(objPtr); @@ -814,6 +823,7 @@ TclReleaseLiteral( * Remove the reference corresponding to the local literal table entry. */ + done: Tcl_DecrRefCount(objPtr); } @@ -836,11 +846,11 @@ TclReleaseLiteral( static unsigned int HashString( - register const char *bytes, /* String for which to compute hash value. */ + const char *bytes, /* String for which to compute hash value. */ int length) /* Number of bytes in the string. */ { - register unsigned int result; - register int i; + unsigned int result; + int i; /* * I tried a zillion different hash functions and asked many other people @@ -850,12 +860,26 @@ HashString( * following reasons: * * 1. Multiplying by 10 is perfect for keys that are decimal strings, and - * multiplying by 9 is just about as good. + * multiplying by 9 is just about as good. * 2. Times-9 is (shift-left-3) plus (old). This means that each - * character's bits hang around in the low-order bits of the hash value - * for ever, plus they spread fairly rapidly up to the high-order bits - * to fill out the hash value. This seems works well both for decimal - * and non-decimal strings. + * character's bits hang around in the low-order bits of the hash value + * for ever, plus they spread fairly rapidly up to the high-order bits + * to fill out the hash value. This seems works well both for decimal + * and non-decimal strings. + * + * Note that this function is very weak against malicious strings; it's + * very easy to generate multiple keys that have the same hashcode. On the + * other hand, that hardly ever actually occurs and this function *is* + * very cheap, even by comparison with industry-standard hashes like FNV. + * If real strength of hash is required though, use a custom hash based on + * Bob Jenkins's lookup3(), but be aware that it's significantly slower. + * Tcl scripts tend to not have a big issue in this area, and literals + * mostly aren't looked up by name anyway. + * + * See also HashStringKey in tclHash.c. + * See also TclObjHashKey in tclObj.c. + * + * See [tcl-Feature Request #2958832] */ result = 0; @@ -885,14 +909,14 @@ HashString( static void RebuildLiteralTable( - register LiteralTable *tablePtr) + LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; - register LiteralEntry **oldChainPtr, **newChainPtr; - register LiteralEntry *entryPtr; + LiteralEntry **oldChainPtr, **newChainPtr; + LiteralEntry *entryPtr; LiteralEntry **bucketPtr; - char *bytes; + const char *bytes; unsigned int oldSize; int count, index, length; @@ -915,8 +939,8 @@ RebuildLiteralTable( } tablePtr->numBuckets *= 4; - tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned) - (tablePtr->numBuckets * sizeof(LiteralEntry *))); + tablePtr->buckets = (LiteralEntry **)ckalloc( + tablePtr->numBuckets * sizeof(LiteralEntry *)); for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets; count>0 ; count--, newChainPtr++) { *newChainPtr = NULL; @@ -934,7 +958,7 @@ RebuildLiteralTable( index = (HashString(bytes, length) & tablePtr->mask); *oldChainPtr = entryPtr->nextPtr; - bucketPtr = &(tablePtr->buckets[index]); + bucketPtr = &tablePtr->buckets[index]; entryPtr->nextPtr = *bucketPtr; *bucketPtr = entryPtr; } @@ -945,7 +969,7 @@ RebuildLiteralTable( */ if (oldBuckets != tablePtr->staticBuckets) { - ckfree((char *) oldBuckets); + ckfree((char *)oldBuckets); } } @@ -975,7 +999,7 @@ TclLiteralStats( #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; double average, tmp; - register LiteralEntry *entryPtr; + LiteralEntry *entryPtr; char *result, *p; /* @@ -1007,7 +1031,7 @@ TclLiteralStats( * Print out the histogram and a few other pieces of information. */ - result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300)); + result = (char *)ckalloc(NUM_COUNTERS*60 + 300); sprintf(result, "%d entries in table, %d buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); @@ -1046,10 +1070,10 @@ TclVerifyLocalLiteralTable( CompileEnv *envPtr) /* Points to CompileEnv whose literal table is * to be validated. */ { - register LiteralTable *localTablePtr = &(envPtr->localLitTable); - register LiteralEntry *localPtr; + LiteralTable *localTablePtr = &envPtr->localLitTable; + LiteralEntry *localPtr; char *bytes; - register int i; + int i; int length, count; count = 0; @@ -1059,23 +1083,26 @@ TclVerifyLocalLiteralTable( count++; if (localPtr->refCount != -1) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d", + Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", + "TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes, localPtr->refCount); } if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, localPtr->objPtr) == NULL) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global", - (length>60? 60 : length), bytes); + Tcl_Panic("%s: local literal \"%.*s\" is not global", + "TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes); } if (localPtr->objPtr->bytes == NULL) { - Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep"); + Tcl_Panic("%s: literal has NULL string rep", + "TclVerifyLocalLiteralTable"); } } } if (count != localTablePtr->numEntries) { - Tcl_Panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d", - count, localTablePtr->numEntries); + Tcl_Panic("%s: local literal table had %d entries, should be %d", + "TclVerifyLocalLiteralTable", count, + localTablePtr->numEntries); } } @@ -1100,10 +1127,10 @@ TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { - register LiteralTable *globalTablePtr = &(iPtr->literalTable); - register LiteralEntry *globalPtr; + LiteralTable *globalTablePtr = &iPtr->literalTable; + LiteralEntry *globalPtr; char *bytes; - register int i; + int i; int length, count; count = 0; @@ -1113,17 +1140,20 @@ TclVerifyGlobalLiteralTable( count++; if (globalPtr->refCount < 1) { bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); - Tcl_Panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d", + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", + "TclVerifyGlobalLiteralTable", (length>60? 60 : length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { - Tcl_Panic("TclVerifyGlobalLiteralTable: literal has NULL string rep"); + Tcl_Panic("%s: literal has NULL string rep", + "TclVerifyGlobalLiteralTable"); } } } if (count != globalTablePtr->numEntries) { - Tcl_Panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d", - count, globalTablePtr->numEntries); + Tcl_Panic("%s: global literal table had %d entries, should be %d", + "TclVerifyGlobalLiteralTable", count, + globalTablePtr->numEntries); } } #endif /*TCL_COMPILE_DEBUG*/ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 67cb68e..d6f1da9 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -36,6 +36,7 @@ #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt +#define TclStaticPackage Tcl_StaticPackage #define TclUnusedStubEntry NULL /* @@ -551,15 +552,16 @@ TclIntStubs tclIntStubs = { NULL, /* 248 */ TclDoubleDigits, /* 249 */ NULL, /* 250 */ - NULL, /* 251 */ + TclRegisterLiteral, /* 251 */ NULL, /* 252 */ NULL, /* 253 */ NULL, /* 254 */ NULL, /* 255 */ NULL, /* 256 */ - NULL, /* 257 */ + TclStaticPackage, /* 257 */ NULL, /* 258 */ - TclUnusedStubEntry, /* 259 */ + NULL, /* 259 */ + TclUnusedStubEntry, /* 260 */ }; TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclTest.c b/generic/tclTest.c index ba25873..6e0fbed 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -61,7 +61,7 @@ typedef struct TestAsyncHandler { /* Next is list of handlers. */ } TestAsyncHandler; -TCL_DECLARE_MUTEX(asyncTestMutex); +TCL_DECLARE_MUTEX(asyncTestMutex) static TestAsyncHandler *firstHandler = NULL; @@ -84,7 +84,7 @@ static Tcl_Trace cmdTrace; * TestdelCmd: */ -typedef struct DelCmd { +typedef struct { Tcl_Interp *interp; /* Interpreter in which command exists. */ char *deleteCmd; /* Script to execute when command is deleted. * Malloc'ed. */ @@ -95,7 +95,7 @@ typedef struct DelCmd { * command. */ -typedef struct TclEncoding { +typedef struct { Tcl_Interp *interp; char *toUtfCmd; char *fromUtfCmd; @@ -151,10 +151,8 @@ static void CleanupTestSetassocdataTests( ClientData clientData, Tcl_Interp *interp); static void CmdDelProc1(ClientData clientData); static void CmdDelProc2(ClientData clientData); -static int CmdProc1(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int CmdProc2(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +static Tcl_CmdProc CmdProc1; +static Tcl_CmdProc CmdProc2; static void CmdTraceDeleteProc( ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, @@ -164,16 +162,11 @@ static void CmdTraceProc(ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, int argc, char **argv); -static int CreatedCommandProc( - ClientData clientData, Tcl_Interp *interp, - int argc, const char **argv); -static int CreatedCommandProc2( - ClientData clientData, Tcl_Interp *interp, - int argc, const char **argv); +static Tcl_CmdProc CreatedCommandProc; +static Tcl_CmdProc CreatedCommandProc2; static void DelCallbackProc(ClientData clientData, Tcl_Interp *interp); -static int DelCmdProc(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +static Tcl_CmdProc DelCmdProc; static void DelDeleteProc(ClientData clientData); static void EncodingFreeProc(ClientData clientData); static int EncodingToUtfProc(ClientData clientData, @@ -188,14 +181,10 @@ static int EncodingFromUtfProc(ClientData clientData, int *dstCharsPtr); static void ExitProcEven(ClientData clientData); static void ExitProcOdd(ClientData clientData); -static int GetTimesCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +static Tcl_ObjCmdProc GetTimesObjCmd; static void MainLoop(void); -static int NoopCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int NoopObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_CmdProc NoopCmd; +static Tcl_ObjCmdProc NoopObjCmd; static int ObjTraceProc(ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandToken, int objc, @@ -206,13 +195,9 @@ static void SpecialFree(char *blockPtr); static int StaticInitProc(Tcl_Interp *interp); #undef USE_OBSOLETE_FS_HOOKS #ifdef USE_OBSOLETE_FS_HOOKS -static int TestaccessprocCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestopenfilechannelprocCmd( - ClientData dummy, Tcl_Interp *interp, int argc, - const char **argv); -static int TeststatprocCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static Tcl_CmdProc TestaccessprocCmd; +static Tcl_CmdProc TestopenfilechannelprocCmd; +static Tcl_CmdProc TeststatprocCmd; static int PretendTclpAccess(const char *path, int mode); static int TestAccessProc1(const char *path, int mode); static int TestAccessProc2(const char *path, int mode); @@ -234,264 +219,160 @@ static int TestStatProc1(const char *path, struct stat *buf); static int TestStatProc2(const char *path, struct stat *buf); static int TestStatProc3(const char *path, struct stat *buf); #endif -static int TestasyncCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestcmdinfoCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestcmdtokenCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestcmdtraceCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestconcatobjCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestcreatecommandCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestdcallCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestdelCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestdelassocdataCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestdoubledigitsObjCmd(ClientData dummy, - Tcl_Interp* interp, - int objc, Tcl_Obj* const objv[]); -static int TestdstringCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestencodingObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestevalexObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestevalobjvObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TesteventObjCmd(ClientData unused, - Tcl_Interp *interp, int argc, - Tcl_Obj *const objv[]); +static Tcl_CmdProc TestasyncCmd; +static Tcl_ObjCmdProc TestbytestringObjCmd; +static Tcl_ObjCmdProc TeststringbytesObjCmd; +static Tcl_CmdProc TestcmdinfoCmd; +static Tcl_CmdProc TestcmdtokenCmd; +static Tcl_CmdProc TestcmdtraceCmd; +static Tcl_CmdProc TestconcatobjCmd; +static Tcl_CmdProc TestcreatecommandCmd; +static Tcl_CmdProc TestdcallCmd; +static Tcl_CmdProc TestdelCmd; +static Tcl_CmdProc TestdelassocdataCmd; +static Tcl_ObjCmdProc TestdoubledigitsObjCmd; +static Tcl_CmdProc TestdstringCmd; +static Tcl_ObjCmdProc TestencodingObjCmd; +static Tcl_ObjCmdProc TestevalexObjCmd; +static Tcl_ObjCmdProc TestevalobjvObjCmd; +static Tcl_ObjCmdProc TesteventObjCmd; static int TesteventProc(Tcl_Event *event, int flags); static int TesteventDeleteProc(Tcl_Event *event, ClientData clientData); -static int TestexithandlerCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestexprlongCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestexprlongobjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestexprdoubleCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestexprdoubleobjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestexprparserObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestexprstringCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestfileCmd(ClientData dummy, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestfilelinkCmd(ClientData dummy, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestfeventCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestgetassocdataCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestgetintCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestgetplatformCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestgetvarfullnameCmd( - ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestinterpdeleteCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestlinkCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestlocaleCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_CmdProc TestexithandlerCmd; +static Tcl_CmdProc TestexprlongCmd; +static Tcl_ObjCmdProc TestexprlongobjCmd; +static Tcl_CmdProc TestexprdoubleCmd; +static Tcl_ObjCmdProc TestexprdoubleobjCmd; +static Tcl_ObjCmdProc TestexprparserObjCmd; +static Tcl_CmdProc TestexprstringCmd; +static Tcl_ObjCmdProc TestfileCmd; +static Tcl_ObjCmdProc TestfilelinkCmd; +static Tcl_CmdProc TestfeventCmd; +static Tcl_CmdProc TestgetassocdataCmd; +static Tcl_CmdProc TestgetintCmd; +static Tcl_CmdProc TestgetplatformCmd; +static Tcl_ObjCmdProc TestgetvarfullnameCmd; +static Tcl_CmdProc TestinterpdeleteCmd; +static Tcl_CmdProc TestlinkCmd; +static Tcl_ObjCmdProc TestlocaleCmd; static int TestMathFunc(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); static int TestMathFunc2(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); -static int TestmainthreadCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestsetmainloopCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestexitmainloopCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestpanicCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestparserObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestparsevarObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestparsevarnameObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestregexpObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestreturnObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static void TestregexpXflags(char *string, +static Tcl_CmdProc TestmainthreadCmd; +static Tcl_CmdProc TestsetmainloopCmd; +static Tcl_CmdProc TestexitmainloopCmd; +static Tcl_CmdProc TestpanicCmd; +static Tcl_ObjCmdProc TestparserObjCmd; +static Tcl_ObjCmdProc TestparsevarObjCmd; +static Tcl_ObjCmdProc TestparsevarnameObjCmd; +static Tcl_ObjCmdProc TestregexpObjCmd; +static Tcl_ObjCmdProc TestreturnObjCmd; +static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); -static int TestsaveresultCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc TestsaveresultCmd; static void TestsaveresultFree(char *blockPtr); -static int TestsetassocdataCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestsetCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int Testset2Cmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestseterrorcodeCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestsetobjerrorcodeCmd( - ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestsetplatformCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TeststaticpkgCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TesttranslatefilenameCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestupvarCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestWrongNumArgsObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestGetIndexFromObjStructObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestChannelCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int TestChannelEventCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int TestFilesystemObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestSimpleFilesystemObjCmd( - ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_CmdProc TestsetassocdataCmd; +static Tcl_CmdProc TestsetCmd; +static Tcl_CmdProc Testset2Cmd; +static Tcl_CmdProc TestseterrorcodeCmd; +static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; +static Tcl_CmdProc TestsetplatformCmd; +static Tcl_CmdProc TeststaticpkgCmd; +static Tcl_CmdProc TesttranslatefilenameCmd; +static Tcl_CmdProc TestupvarCmd; +static Tcl_ObjCmdProc TestWrongNumArgsObjCmd; +static Tcl_ObjCmdProc TestGetIndexFromObjStructObjCmd; +static Tcl_CmdProc TestChannelCmd; +static Tcl_CmdProc TestChannelEventCmd; +static Tcl_ObjCmdProc TestFilesystemObjCmd; +static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); -static int TestReportStat(Tcl_Obj *path, Tcl_StatBuf *buf); -static int TestReportAccess(Tcl_Obj *path, int mode); -static Tcl_Channel TestReportOpenFileChannel( - Tcl_Interp *interp, Tcl_Obj *fileName, - int mode, int permissions); -static int TestReportMatchInDirectory(Tcl_Interp *interp, - Tcl_Obj *resultPtr, Tcl_Obj *dirPtr, - const char *pattern, Tcl_GlobTypeData *types); -static int TestReportChdir(Tcl_Obj *dirName); -static int TestReportLstat(Tcl_Obj *path, Tcl_StatBuf *buf); -static int TestReportCopyFile(Tcl_Obj *src, Tcl_Obj *dst); -static int TestReportDeleteFile(Tcl_Obj *path); -static int TestReportRenameFile(Tcl_Obj *src, Tcl_Obj *dst); -static int TestReportCreateDirectory(Tcl_Obj *path); -static int TestReportCopyDirectory(Tcl_Obj *src, - Tcl_Obj *dst, Tcl_Obj **errorPtr); -static int TestReportRemoveDirectory(Tcl_Obj *path, - int recursive, Tcl_Obj **errorPtr); -static int TestReportLoadFile(Tcl_Interp *interp, - Tcl_Obj *fileName, Tcl_LoadHandle *handlePtr, - Tcl_FSUnloadFileProc **unloadProcPtr); -static Tcl_Obj * TestReportLink(Tcl_Obj *path, - Tcl_Obj *to, int linkType); -static const char ** TestReportFileAttrStrings( - Tcl_Obj *fileName, Tcl_Obj **objPtrRef); -static int TestReportFileAttrsGet(Tcl_Interp *interp, - int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef); -static int TestReportFileAttrsSet(Tcl_Interp *interp, - int index, Tcl_Obj *fileName, Tcl_Obj *objPtr); -static int TestReportUtime(Tcl_Obj *fileName, - struct utimbuf *tval); -static int TestReportNormalizePath(Tcl_Interp *interp, - Tcl_Obj *pathPtr, int nextCheckpoint); -static int TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr); -static void TestReportFreeInternalRep(ClientData clientData); -static ClientData TestReportDupInternalRep(ClientData clientData); - -static int SimpleStat(Tcl_Obj *path, Tcl_StatBuf *buf); -static int SimpleAccess(Tcl_Obj *path, int mode); -static Tcl_Channel SimpleOpenFileChannel(Tcl_Interp *interp, - Tcl_Obj *fileName, int mode, int permissions); -static Tcl_Obj * SimpleListVolumes(void); -static int SimplePathInFilesystem( - Tcl_Obj *pathPtr, ClientData *clientDataPtr); +static Tcl_FSStatProc TestReportStat; +static Tcl_FSAccessProc TestReportAccess; +static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel; +static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory; +static Tcl_FSChdirProc TestReportChdir; +static Tcl_FSLstatProc TestReportLstat; +static Tcl_FSCopyFileProc TestReportCopyFile; +static Tcl_FSDeleteFileProc TestReportDeleteFile; +static Tcl_FSRenameFileProc TestReportRenameFile; +static Tcl_FSCreateDirectoryProc TestReportCreateDirectory; +static Tcl_FSCopyDirectoryProc TestReportCopyDirectory; +static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory; +static int TestReportLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, + Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); +static Tcl_FSLinkProc TestReportLink; +static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings; +static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet; +static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet; +static Tcl_FSUtimeProc TestReportUtime; +static Tcl_FSNormalizePathProc TestReportNormalizePath; +static Tcl_FSPathInFilesystemProc TestReportInFilesystem; +static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep; +static Tcl_FSDupInternalRepProc TestReportDupInternalRep; + +static Tcl_FSStatProc SimpleStat; +static Tcl_FSAccessProc SimpleAccess; +static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel; +static Tcl_FSListVolumesProc SimpleListVolumes; +static Tcl_FSPathInFilesystemProc SimplePathInFilesystem; static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr); -static int SimpleMatchInDirectory( - Tcl_Interp *interp, Tcl_Obj *resultPtr, - Tcl_Obj *dirPtr, const char *pattern, - Tcl_GlobTypeData *types); +static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; static Tcl_ObjCmdProc TestUtfNextCmd; static Tcl_ObjCmdProc TestUtfPrevCmd; -static int TestNumUtfCharsCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestFindFirstCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestFindLastCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestHashSystemHashCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -#if defined(HAVE_CPUID) || defined(__WIN32__) -static int TestcpuidCmd (ClientData dummy, - Tcl_Interp* interp, int objc, - Tcl_Obj *CONST objv[]); +static Tcl_ObjCmdProc TestNumUtfCharsCmd; +static Tcl_ObjCmdProc TestFindFirstCmd; +static Tcl_ObjCmdProc TestFindLastCmd; +static Tcl_ObjCmdProc TestHashSystemHashCmd; +#if defined(HAVE_CPUID) || defined(_WIN32) +static Tcl_ObjCmdProc TestcpuidCmd; #endif static Tcl_Filesystem testReportingFilesystem = { "reporting", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, - &TestReportInFilesystem, /* path in */ - &TestReportDupInternalRep, - &TestReportFreeInternalRep, + TestReportInFilesystem, /* path in */ + TestReportDupInternalRep, + TestReportFreeInternalRep, NULL, /* native to norm */ NULL, /* convert to native */ - &TestReportNormalizePath, + TestReportNormalizePath, NULL, /* path type */ NULL, /* separator */ - &TestReportStat, - &TestReportAccess, - &TestReportOpenFileChannel, - &TestReportMatchInDirectory, - &TestReportUtime, - &TestReportLink, + TestReportStat, + TestReportAccess, + TestReportOpenFileChannel, + TestReportMatchInDirectory, + TestReportUtime, + TestReportLink, NULL /* list volumes */, - &TestReportFileAttrStrings, - &TestReportFileAttrsGet, - &TestReportFileAttrsSet, - &TestReportCreateDirectory, - &TestReportRemoveDirectory, - &TestReportDeleteFile, - &TestReportCopyFile, - &TestReportRenameFile, - &TestReportCopyDirectory, - &TestReportLstat, - (Tcl_FSLoadFileProc *) &TestReportLoadFile, + TestReportFileAttrStrings, + TestReportFileAttrsGet, + TestReportFileAttrsSet, + TestReportCreateDirectory, + TestReportRemoveDirectory, + TestReportDeleteFile, + TestReportCopyFile, + TestReportRenameFile, + TestReportCopyDirectory, + TestReportLstat, + (Tcl_FSLoadFileProc *) TestReportLoadFile, NULL /* cwd */, - &TestReportChdir + TestReportChdir }; static Tcl_Filesystem simpleFilesystem = { "simple", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, - &SimplePathInFilesystem, + SimplePathInFilesystem, NULL, NULL, /* No internal to normalized, since we don't create any @@ -505,14 +386,14 @@ static Tcl_Filesystem simpleFilesystem = { NULL, NULL, NULL, - &SimpleStat, - &SimpleAccess, - &SimpleOpenFileChannel, - &SimpleMatchInDirectory, + SimpleStat, + SimpleAccess, + SimpleOpenFileChannel, + SimpleMatchInDirectory, NULL, /* We choose not to support symbolic links inside our vfs's */ NULL, - &SimpleListVolumes, + SimpleListVolumes, NULL, NULL, NULL, @@ -569,14 +450,19 @@ Tcltest_Init( { Tcl_ValueType t3ArgTypes[2]; - Tcl_Obj *listPtr; - Tcl_Obj **objv; + Tcl_Obj **objv, *objPtr; int objc, index; static const char *const specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + return TCL_ERROR; + } + if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) { + return TCL_ERROR; + } /* TIP #268: Full patchlevel instead of just major.minor */ if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { @@ -587,115 +473,117 @@ Tcltest_Init( * Create additional commands and math functions for testing Tcl. */ - Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0, NULL); + Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); + Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", - TestGetIndexFromObjStructObjCmd, (ClientData) 0, NULL); + TestGetIndexFromObjStructObjCmd, NULL, NULL); #ifdef USE_OBSOLETE_FS_HOOKS - Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0, + Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, NULL, NULL); Tcl_CreateCommand(interp, "testopenfilechannelproc", - TestopenfilechannelprocCmd, (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0, + TestopenfilechannelprocCmd, NULL, NULL); + Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, NULL, NULL); #endif - Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, - (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0, + NULL, NULL); + Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0, + Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd, - (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0, NULL); + NULL, NULL); + Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd, NULL, NULL); Tcl_DStringInit(&dstring); - Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0, + Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0, + Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testevent", TesteventObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd, - (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0, + NULL, NULL); + Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testfile", TestfileCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testhashsystemhash", - TestHashSystemHashCmd, (ClientData) 0, NULL); + TestHashSystemHashCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testgetint", TestgetintCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testgetvarfullname", - TestgetvarfullnameCmd, (ClientData) 0, NULL); + TestgetvarfullnameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd, - (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0, + NULL, NULL); + Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testseterr", TestsetCmd, (ClientData) TCL_LEAVE_ERR_MSG, NULL); Tcl_CreateCommand(interp, "testset2", Testset2Cmd, (ClientData) TCL_LEAVE_ERR_MSG, NULL); Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testutfnext", @@ -709,28 +597,28 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testfindlast", TestFindLastCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, - (ClientData) 0, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", - TesttranslatefilenameCmd, (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0, NULL); + TesttranslatefilenameCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); - Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0, + Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, - (ClientData) NULL, NULL); + NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, - (ClientData) NULL, NULL); -#if defined(HAVE_CPUID) || defined(__WIN32__) + NULL, NULL); +#if defined(HAVE_CPUID) || defined(_WIN32) Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, - (ClientData) 0, NULL); + NULL, NULL); #endif t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, - (ClientData) 0); + NULL); #ifdef TCL_THREADS if (TclThread_Init(interp) != TCL_OK) { @@ -742,9 +630,9 @@ Tcltest_Init( * Check for special options used in ../tests/main.test */ - listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); - if (listPtr != NULL) { - if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { + objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); + if (objPtr != NULL) { + if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { return TCL_ERROR; } if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL, @@ -806,19 +694,19 @@ TestasyncCmd( TestAsyncHandler *asyncPtr, *prevPtr; int id, code; static int nextId = 1; - char buf[TCL_INTEGER_SPACE]; + (void)dummy; if (argc < 2) { wrongNumArgs: - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { if (argc != 3) { goto wrongNumArgs; } - asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler)); - asyncPtr->command = ckalloc(strlen(argv[2]) + 1); + asyncPtr = (TestAsyncHandler *)ckalloc(sizeof(TestAsyncHandler)); + asyncPtr->command = (char *)ckalloc(strlen(argv[2]) + 1); strcpy(asyncPtr->command, argv[2]); Tcl_MutexLock(&asyncTestMutex); asyncPtr->id = nextId; @@ -828,8 +716,7 @@ TestasyncCmd( asyncPtr->nextPtr = firstHandler; firstHandler = asyncPtr; Tcl_MutexUnlock(&asyncTestMutex); - TclFormatInt(buf, asyncPtr->id); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id)); } else if (strcmp(argv[1], "delete") == 0) { if (argc == 2) { Tcl_MutexLock(&asyncTestMutex); @@ -838,7 +725,7 @@ TestasyncCmd( firstHandler = asyncPtr->nextPtr; Tcl_AsyncDelete(asyncPtr->handler); ckfree(asyncPtr->command); - ckfree((char *) asyncPtr); + ckfree((char *)asyncPtr); } Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; @@ -862,7 +749,7 @@ TestasyncCmd( } Tcl_AsyncDelete(asyncPtr->handler); ckfree(asyncPtr->command); - ckfree((char *) asyncPtr); + ckfree((char *)asyncPtr); break; } Tcl_MutexUnlock(&asyncTestMutex); @@ -874,7 +761,7 @@ TestasyncCmd( || (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) { return TCL_ERROR; } - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { @@ -882,8 +769,8 @@ TestasyncCmd( break; } } - Tcl_MutexUnlock(&asyncTestMutex); - Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1)); + Tcl_MutexUnlock(&asyncTestMutex); return code; #ifdef TCL_THREADS } else if (strcmp(argv[1], "marklater") == 0) { @@ -899,9 +786,9 @@ TestasyncCmd( if (asyncPtr->id == id) { Tcl_ThreadId threadID; if (Tcl_CreateThread(&threadID, AsyncThreadProc, - (ClientData) INT2PTR(id), TCL_THREAD_STACK_DEFAULT, + INT2PTR(id), TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { - Tcl_SetResult(interp, "can't create thread", TCL_STATIC); + Tcl_AppendResult(interp, "can't create thread", NULL); Tcl_MutexUnlock(&asyncTestMutex); return TCL_ERROR; } @@ -938,8 +825,10 @@ AsyncHandlerProc( Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; - asyncPtr = asyncPtr->nextPtr) { - if (asyncPtr->id == id) break; + asyncPtr = asyncPtr->nextPtr) { + if (asyncPtr->id == id) { + break; + } } Tcl_MutexUnlock(&asyncTestMutex); @@ -1033,6 +922,7 @@ TestcmdinfoCmd( const char **argv) /* Argument strings. */ { Tcl_CmdInfo info; + (void)dummy; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -1048,7 +938,7 @@ TestcmdinfoCmd( Tcl_DStringResult(interp, &delString); } else if (strcmp(argv[1], "get") == 0) { if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) { - Tcl_SetResult(interp, "??", TCL_STATIC); + Tcl_AppendResult(interp, "??", NULL); return TCL_OK; } if (info.proc == CmdProc1) { @@ -1079,13 +969,13 @@ TestcmdinfoCmd( info.proc = CmdProc2; info.clientData = (ClientData) "new_command_data"; info.objProc = NULL; - info.objClientData = (ClientData) NULL; + info.objClientData = NULL; info.deleteProc = CmdDelProc2; info.deleteData = (ClientData) "new_delete_data"; if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) { - Tcl_SetResult(interp, "0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } else { - Tcl_SetResult(interp, "1", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], @@ -1238,7 +1128,7 @@ TestcmdtraceCmd( if (strcmp(argv[1], "tracetest") == 0) { Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, 50000, - (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); + (Tcl_CmdTraceProc *) CmdTraceProc, &buffer); result = Tcl_Eval(interp, argv[2]); if (result == TCL_OK) { Tcl_ResetResult(interp); @@ -1255,13 +1145,13 @@ TestcmdtraceCmd( */ cmdTrace = Tcl_CreateTrace(interp, 50000, - (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL); + (Tcl_CmdTraceProc *) CmdTraceDeleteProc, NULL); Tcl_Eval(interp, argv[2]); } else if (strcmp(argv[1], "leveltest") == 0) { Interp *iPtr = (Interp *) interp; Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, - (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); + (Tcl_CmdTraceProc *) CmdTraceProc, &buffer); result = Tcl_Eval(interp, argv[2]); if (result == TCL_OK) { Tcl_ResetResult(interp); @@ -1432,12 +1322,12 @@ TestcreatecommandCmd( } if (strcmp(argv[1], "create") == 0) { Tcl_CreateCommand(interp, "test_ns_basic::createdcommand", - CreatedCommandProc, (ClientData) NULL, NULL); + CreatedCommandProc, NULL, NULL); } else if (strcmp(argv[1], "delete") == 0) { Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand"); } else if (strcmp(argv[1], "create2") == 0) { Tcl_CreateCommand(interp, "value:at:", - CreatedCommandProc2, (ClientData) NULL, NULL); + CreatedCommandProc2, NULL, NULL); } else if (strcmp(argv[1], "delete2") == 0) { Tcl_DeleteCommand(interp, "value:at:"); } else { @@ -1594,9 +1484,9 @@ TestdelCmd( return TCL_ERROR; } - dPtr = (DelCmd *) ckalloc(sizeof(DelCmd)); + dPtr = (DelCmd *)ckalloc(sizeof(DelCmd)); dPtr->interp = interp; - dPtr->deleteCmd = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1)); + dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1); strcpy(dPtr->deleteCmd, argv[3]); Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr, @@ -1615,7 +1505,7 @@ DelCmdProc( Tcl_AppendResult(interp, dPtr->deleteCmd, NULL); ckfree(dPtr->deleteCmd); - ckfree((char *) dPtr); + ckfree((char *)dPtr); return TCL_OK; } @@ -1623,12 +1513,12 @@ static void DelDeleteProc( ClientData clientData) /* String command to evaluate. */ { - DelCmd *dPtr = (DelCmd *) clientData; + DelCmd *dPtr = (DelCmd *)clientData; Tcl_Eval(dPtr->interp, dPtr->deleteCmd); Tcl_ResetResult(dPtr->interp); ckfree(dPtr->deleteCmd); - ckfree((char *) dPtr); + ckfree((char *)dPtr); } /* @@ -1830,13 +1720,13 @@ TestdstringCmd( } else if (strcmp(argv[2], "staticlarge") == 0) { Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC); } else if (strcmp(argv[2], "free") == 0) { - Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC); - strcpy(interp->result, "This is a malloc-ed string"); + char *s = ckalloc(100); + strcpy(s, "This is a malloc-ed string"); + Tcl_SetResult(interp, s, TCL_DYNAMIC); } else if (strcmp(argv[2], "special") == 0) { - interp->result = (char *) ckalloc(100); - interp->result += 4; - interp->freeProc = SpecialFree; - strcpy(interp->result, "This is a specially-allocated string"); + char *s = (char*)ckalloc(100) + 16; + strcpy(s, "This is a specially-allocated string"); + Tcl_SetResult(interp, s, SpecialFree); } else { Tcl_AppendResult(interp, "bad gresult option \"", argv[2], "\": must be staticsmall, staticlarge, free, or special", @@ -1845,13 +1735,11 @@ TestdstringCmd( } Tcl_DStringGetResult(interp, &dstring); } else if (strcmp(argv[1], "length") == 0) { - char buf[TCL_INTEGER_SPACE]; if (argc != 2) { goto wrongNumArgs; } - TclFormatInt(buf, Tcl_DStringLength(&dstring)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring))); } else if (strcmp(argv[1], "result") == 0) { if (argc != 2) { goto wrongNumArgs; @@ -1887,7 +1775,7 @@ TestdstringCmd( static void SpecialFree(blockPtr) char *blockPtr; /* Block to free. */ { - ckfree(blockPtr - 4); + ckfree(blockPtr - 16); } /* @@ -1917,7 +1805,7 @@ TestencodingObjCmd( { Tcl_Encoding encoding; int index, length; - char *string; + const char *string; TclEncoding *encodingPtr; static const char *optionStrings[] = { "create", "delete", NULL @@ -1938,15 +1826,15 @@ TestencodingObjCmd( if (objc != 5) { return TCL_ERROR; } - encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding)); + encodingPtr = (TclEncoding *)ckalloc(sizeof(TclEncoding)); encodingPtr->interp = interp; string = Tcl_GetStringFromObj(objv[3], &length); - encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1)); + encodingPtr->toUtfCmd = (char *)ckalloc(length + 1); memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1); string = Tcl_GetStringFromObj(objv[4], &length); - encodingPtr->fromUtfCmd = (char *) ckalloc((unsigned) (length + 1)); + encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1); memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1)); string = Tcl_GetStringFromObj(objv[2], &length); @@ -2041,12 +1929,11 @@ static void EncodingFreeProc( ClientData clientData) /* ClientData associated with type. */ { - TclEncoding *encodingPtr; + TclEncoding *encodingPtr = (TclEncoding *)clientData; - encodingPtr = (TclEncoding *) clientData; - ckfree((char *) encodingPtr->toUtfCmd); - ckfree((char *) encodingPtr->fromUtfCmd); - ckfree((char *) encodingPtr); + ckfree((char *)encodingPtr->toUtfCmd); + ckfree((char *)encodingPtr->fromUtfCmd); + ckfree((char *)encodingPtr); } /* @@ -2074,11 +1961,11 @@ TestevalexObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int length, flags; - char *script; + const char *script; flags = 0; if (objc == 3) { - char *global = Tcl_GetStringFromObj(objv[2], &length); + const char *global = Tcl_GetString(objv[2]); if (strcmp(global, "global") != 0) { Tcl_AppendResult(interp, "bad value \"", global, "\": must be global", NULL); @@ -2184,7 +2071,7 @@ TesteventObjCmd( TestEvent *ev; /* Event to be queued */ if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); + Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand", @@ -2201,7 +2088,7 @@ TesteventObjCmd( "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { return TCL_ERROR; } - ev = (TestEvent *) ckalloc(sizeof(TestEvent)); + ev = (TestEvent *)ckalloc(sizeof(TestEvent)); ev->header.proc = TesteventProc; ev->header.nextPtr = NULL; ev->interp = interp; @@ -2302,17 +2189,17 @@ TesteventDeleteProc( * to remove */ { TestEvent *ev; /* Event to examine */ - char *evNameStr; + const char *evNameStr; Tcl_Obj *targetName; /* Name of the event(s) to delete */ - char *targetNameStr; + const char *targetNameStr; if (event->proc != TesteventProc) { return 0; } targetName = (Tcl_Obj *) clientData; - targetNameStr = (char *) Tcl_GetStringFromObj(targetName, NULL); + targetNameStr = (char *) Tcl_GetString(targetName); ev = (TestEvent *) event; - evNameStr = Tcl_GetStringFromObj(ev->tag, NULL); + evNameStr = Tcl_GetString(ev->tag); if (strcmp(evNameStr, targetNameStr) == 0) { Tcl_DecrRefCount(ev->tag); Tcl_DecrRefCount(ev->command); @@ -2821,7 +2708,7 @@ TestlinkCmd( static unsigned char ucharVar = 130; static short shortVar = 3000; static unsigned short ushortVar = 60000; - static unsigned int uintVar = 0xbeeffeed; + static unsigned int uintVar = 0xBEEFFEED; static long longVar = 123456789L; static unsigned long ulongVar = 3456789012UL; static float floatVar = 4.5; @@ -3059,7 +2946,7 @@ TestlinkCmd( if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1)); + stringVar = (char *)ckalloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } } @@ -3166,7 +3053,7 @@ TestlinkCmd( if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1)); + stringVar = (char *)ckalloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } Tcl_UpdateLinkedVar(interp, "string"); @@ -3281,13 +3168,13 @@ TestlocaleCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { int index; - char *locale; + const char *locale; static const char *optionStrings[] = { - "ctype", "numeric", "time", "collate", "monetary", + "ctype", "numeric", "time", "collate", "monetary", "all", NULL }; - static CONST int lcTypes[] = { + static const int lcTypes[] = { LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY, LC_ALL }; @@ -3478,7 +3365,7 @@ CleanupTestSetassocdataTests( ClientData clientData, /* Data to be released. */ Tcl_Interp *interp) /* Interpreter being deleted. */ { - ckfree((char *) clientData); + ckfree((char *)clientData); } /* @@ -3505,7 +3392,7 @@ TestparserObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - char *script; + const char *script; int length, dummy; Tcl_Parse parse; @@ -3561,7 +3448,7 @@ TestexprparserObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - char *script; + const char *script; int length, dummy; Tcl_Parse parse; @@ -3749,7 +3636,7 @@ TestparsevarnameObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - char *script; + const char *script; int append, length, dummy; Tcl_Parse parse; @@ -3817,7 +3704,7 @@ TestregexpObjCmd( int i, ii, indices, stringLength, match, about; int hasxflags, cflags, eflags; Tcl_RegExp regExpr; - char *string; + const char *string; Tcl_Obj *objPtr; Tcl_RegExpInfo info; static const char *options[] = { @@ -3840,7 +3727,7 @@ TestregexpObjCmd( hasxflags = 0; for (i = 1; i < objc; i++) { - char *name; + const char *name; int index; name = Tcl_GetString(objv[i]); @@ -3885,7 +3772,7 @@ TestregexpObjCmd( endOfForLoop: if (objc - i < hasxflags + 2 - about) { Tcl_WrongNumArgs(interp, 1, objv, - "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"); + "?-switch ...? exp string ?matchVar? ?subMatchVar ...?"); return TCL_ERROR; } objc -= i; @@ -3925,7 +3812,7 @@ TestregexpObjCmd( Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { - char *varName; + const char *varName; const char *value; int start, end; char resinfo[TCL_INTEGER_SPACE * 2]; @@ -3940,7 +3827,7 @@ TestregexpObjCmd( return TCL_ERROR; } } else if (cflags & TCL_REG_CANMATCH) { - char *varName; + const char *varName; const char *value; char resinfo[TCL_INTEGER_SPACE * 2]; @@ -4044,7 +3931,7 @@ TestregexpObjCmd( static void TestregexpXflags( - char *string, /* The string of flags. */ + const char *string, /* The string of flags. */ int length, /* The length of the string in bytes. */ int *cflagsPtr, /* compile flags word */ int *eflagsPtr) /* exec flags word */ @@ -4177,7 +4064,7 @@ TestsetassocdataCmd( return TCL_ERROR; } - buf = ckalloc((unsigned) strlen(argv[2]) + 1); + buf = ckalloc(strlen(argv[2]) + 1); strcpy(buf, argv[2]); /* @@ -4419,8 +4306,26 @@ TestseterrorcodeCmd( Tcl_SetResult(interp, "too many args", TCL_STATIC); return TCL_ERROR; } - Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], - argv[5], NULL); + switch (argc) { + case 1: + Tcl_SetErrorCode(interp, "NONE", NULL); + break; + case 2: + Tcl_SetErrorCode(interp, argv[1], NULL); + break; + case 3: + Tcl_SetErrorCode(interp, argv[1], argv[2], NULL); + break; + case 4: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL); + break; + case 5: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL); + break; + case 6: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], + argv[5], NULL); + } return TCL_ERROR; } @@ -4485,7 +4390,7 @@ TestfeventCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg arg ...?", NULL); + " option ?arg ...?", NULL); return TCL_ERROR; } if (strcmp(argv[1], "cmd") == 0) { @@ -4551,7 +4456,7 @@ TestpanicCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - const char *argString; + char *argString; /* * Put the arguments into a var args structure @@ -4560,11 +4465,11 @@ TestpanicCmd( argString = Tcl_Merge(argc-1, argv+1); Tcl_Panic("%s", argString); - ckfree((char *)argString); + ckfree(argString); return TCL_OK; } - + static int TestfileCmd( ClientData dummy, /* Not used. */ @@ -4574,7 +4479,7 @@ TestfileCmd( { int force, i, j, result; Tcl_Obj *error = NULL; - char *subcmd; + const char *subcmd; if (argc < 3) { return TCL_ERROR; @@ -4654,7 +4559,7 @@ TestgetvarfullnameCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - char *name, *arg; + const char *name, *arg; int flags = 0; Tcl_Namespace *namespacePtr; Tcl_CallFrame *framePtr; @@ -4710,7 +4615,7 @@ TestgetvarfullnameCmd( /* *---------------------------------------------------------------------- * - * GetTimesCmd -- + * GetTimesObjCmd -- * * This procedure implements the "gettimes" command. It is used for * computing the time needed for various basic operations such as reading @@ -4726,11 +4631,11 @@ TestgetvarfullnameCmd( */ static int -GetTimesCmd( +GetTimesObjCmd( ClientData unused, /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ - int argc, /* The number of arguments. */ - const char **argv) /* The argument strings. */ + int objc, /* Number of arguments. (not used)*/ + Tcl_Obj *const dummy[]) /* The argument objects (not used). */ { Interp *iPtr = (Interp *) interp; int i, n; @@ -4739,13 +4644,15 @@ GetTimesCmd( Tcl_Obj *objPtr, **objv; const char *s; char newString[TCL_INTEGER_SPACE]; + (void)objc; + (void)dummy; /* alloc & free 100000 times */ fprintf(stderr, "alloc & free 100000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - objPtr = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)); - ckfree((char *) objPtr); + objPtr = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)); + ckfree((char *)objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -4766,7 +4673,7 @@ GetTimesCmd( fprintf(stderr, "free 5000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - ckfree((char *) objv[i]); + ckfree((char *)objv[i]); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -4792,7 +4699,7 @@ GetTimesCmd( Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000); - ckfree((char *) objv); + ckfree((char *)objv); /* TclGetString 100000 times */ fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n"); @@ -4944,6 +4851,79 @@ NoopObjCmd( /* *---------------------------------------------------------------------- * + * TeststringbytesObjCmd -- + * Returns bytearray value of the bytes in argument string rep + * + * Results: + * Returns the TCL_OK result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TeststringbytesObjCmd( + ClientData dummy, + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + int n; + const unsigned char *p; + (void)dummy; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "value"); + return TCL_ERROR; + } + p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n); + Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(p, n)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestbytestringObjCmd -- + * + * This object-based procedure constructs a string which can + * possibly contain invalid UTF-8 bytes. + * + * Results: + * Returns the TCL_OK result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestbytestringObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + int n = 0; + const char *p; + (void)dummy; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "bytearray"); + return TCL_ERROR; + } + + p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n); + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestsetCmd -- * * Implements the "testset{err,noerr}" cmds that are used when testing @@ -4958,11 +4938,10 @@ NoopObjCmd( *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestsetCmd( ClientData data, /* Additional flags for Get/SetVar2. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { @@ -4994,7 +4973,7 @@ TestsetCmd( static int Testset2Cmd( ClientData data, /* Additional flags for Get/SetVar2. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { @@ -5041,14 +5020,14 @@ Testset2Cmd( *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestsaveresultCmd( ClientData dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { + Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; @@ -5091,7 +5070,7 @@ TestsaveresultCmd( break; } case RESULT_DYNAMIC: - Tcl_SetResult(interp, "dynamic result", TestsaveresultFree); + Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree); break; case RESULT_OBJECT: objPtr = Tcl_NewStringObj("object result", -1); @@ -5117,7 +5096,7 @@ TestsaveresultCmd( switch ((enum options) index) { case RESULT_DYNAMIC: { - int present = interp->freeProc == TestsaveresultFree; + int present = iPtr->freeProc == TestsaveresultFree; int called = freeCount; Tcl_AppendElement(interp, called ? "called" : "notCalled"); @@ -5394,7 +5373,7 @@ TestmainthreadCmd( * A main loop set by TestsetmainloopCmd below. * * Results: - * None. + * None. * * Side effects: * Event handlers could do anything. @@ -5432,7 +5411,7 @@ MainLoop(void) static int TestsetmainloopCmd( ClientData dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { @@ -5461,7 +5440,7 @@ TestsetmainloopCmd( static int TestexitmainloopCmd( ClientData dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { @@ -5836,7 +5815,7 @@ TestChannelCmd( *nextPtrPtr = curPtr->nextPtr; curPtr->nextPtr = NULL; chan = curPtr->chan; - ckfree((char *) curPtr); + ckfree((char *)curPtr); break; } } @@ -6076,8 +6055,8 @@ TestChannelCmd( return TCL_ERROR; } - TclFormatInt(buf, (long)(size_t)Tcl_GetChannelThread(chan)); - Tcl_AppendResult(interp, buf, NULL); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( + (Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan))); return TCL_OK; } @@ -6362,7 +6341,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, (ClientData) esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree((char *) esPtr); + ckfree((char *)esPtr); return TCL_OK; } @@ -6403,7 +6382,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, (ClientData) esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree((char *) esPtr); + ckfree((char *)esPtr); } statePtr->scriptRecordPtr = NULL; return TCL_OK; @@ -6479,7 +6458,7 @@ TestWrongNumArgsObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int i, length; - char *msg; + const char *msg; if (objc < 3) { /* @@ -6534,7 +6513,7 @@ TestGetIndexFromObjStructObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *ary[] = { + const char *const ary[] = { "a", "b", "c", "d", "e", "f", NULL, NULL }; int idx,target; @@ -6589,7 +6568,7 @@ TestFilesystemObjCmd( Tcl_Obj *const objv[]) { int res, boolVal; - char *msg; + const char *msg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "boolean"); @@ -6605,7 +6584,7 @@ TestFilesystemObjCmd( res = Tcl_FSUnregister(&testReportingFilesystem); msg = (res == TCL_OK) ? "unregistered" : "failed"; } - Tcl_SetResult(interp, msg, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1)); return res; } @@ -6961,7 +6940,7 @@ TestSimpleFilesystemObjCmd( Tcl_Obj *const objv[]) { int res, boolVal; - char *msg; + const char *msg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "boolean"); @@ -6977,7 +6956,7 @@ TestSimpleFilesystemObjCmd( res = Tcl_FSUnregister(&simpleFilesystem); msg = (res == TCL_OK) ? "unregistered" : "failed"; } - Tcl_SetResult(interp, msg, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1)); return res; } @@ -7277,7 +7256,7 @@ TestFindLastCmd( return TCL_OK; } -#if defined(HAVE_CPUID) || defined(__WIN32__) +#if defined(HAVE_CPUID) || defined(_WIN32) /* *---------------------------------------------------------------------- * @@ -7339,7 +7318,7 @@ TestcpuidCmd( static int TestHashSystemHashCmd( - ClientData clientData, + ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -7351,6 +7330,7 @@ TestHashSystemHashCmd( Tcl_HashTable hash; Tcl_HashEntry *hPtr; int i, isNew, limit = 100; + (void)dummy; if (objc>1 && Tcl_GetIntFromObj(interp, objv[1], &limit)!=TCL_OK) { return TCL_ERROR; @@ -7365,14 +7345,14 @@ TestHashSystemHashCmd( } for (i=0 ; ibytes != NULL) { - ckfree((char *) list1Ptr->bytes); + ckfree((char *)list1Ptr->bytes); list1Ptr->bytes = NULL; } list2Ptr = Tcl_NewStringObj("eeny meeny", -1); Tcl_ListObjLength(NULL, list2Ptr, &len); if (list2Ptr->bytes != NULL) { - ckfree((char *) list2Ptr->bytes); + ckfree((char *)list2Ptr->bytes); list2Ptr->bytes = NULL; } -- cgit v0.12