summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h9
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclBinary.c8
-rw-r--r--generic/tclCmdMZ.c3
-rw-r--r--generic/tclCompCmds.c6
-rw-r--r--generic/tclCompCmdsSZ.c14
-rw-r--r--generic/tclDictObj.c4
-rw-r--r--generic/tclDisassemble.c2
-rw-r--r--generic/tclEnv.c13
-rw-r--r--generic/tclExecute.c14
-rw-r--r--generic/tclHash.c45
-rw-r--r--generic/tclIOSock.c2
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclObj.c15
-rw-r--r--generic/tclParse.c7
-rw-r--r--generic/tclStringObj.c41
-rw-r--r--generic/tclThreadTest.c9
-rw-r--r--generic/tclUtf.c27
-rw-r--r--generic/tclUtil.c4
-rw-r--r--generic/tclVar.c8
20 files changed, 140 insertions, 103 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index d1996a3..3f96d08 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -208,9 +208,6 @@ extern "C" {
#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
# define CONST86 const
#endif
-#ifndef CONST90
-# define CONST90 const
-#endif
/*
* Make sure EXTERN isn't defined elsewhere.
@@ -967,10 +964,10 @@ typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;
-typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, CONST90 void *keyPtr);
-typedef int (Tcl_CompareHashKeysProc) (CONST90 void *keyPtr, Tcl_HashEntry *hPtr);
+typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
+typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
- CONST90 void *keyPtr);
+ void *keyPtr);
typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 705cccb..e2f70f6 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -7911,18 +7911,12 @@ TclNRTailcallObjCmd(
if (objc > 1) {
Tcl_Obj *listPtr, *nsObjPtr;
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
- Tcl_Namespace *ns1Ptr;
/* The tailcall data is in a Tcl list: the first element is the
* namespace, the rest the command to be tailcalled. */
- listPtr = Tcl_NewListObj(objc, objv);
-
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
- if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
- || (nsPtr != ns1Ptr)) {
- Tcl_Panic("Tailcall failed to find the proper namespace");
- }
+ listPtr = Tcl_NewListObj(objc, objv);
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
iPtr->varFramePtr->tailcallPtr = listPtr;
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index acc8fa5..a34bd27 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2479,7 +2479,7 @@ BinaryDecodeHex(
}
c = *data++;
- if (!isxdigit((int) c)) {
+ if (!isxdigit(c)) {
if (strict || !isspace(c)) {
goto badChar;
}
@@ -2513,7 +2513,7 @@ BinaryDecodeHex(
badChar:
TclDecrRefCount(resultObj);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid hexadecimal digit \"%c\" at position %td",
+ "invalid hexadecimal digit \"%c\" at position %" TCL_Z_MODIFIER "d",
c, data - datastart - 1));
return TCL_ERROR;
}
@@ -2915,7 +2915,7 @@ BinaryDecodeUu(
badUu:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid uuencode character \"%c\" at position %td",
+ "invalid uuencode character \"%c\" at position %" TCL_Z_MODIFIER "d",
c, data - datastart - 1));
Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
TclDecrRefCount(resultObj);
@@ -3065,7 +3065,7 @@ BinaryDecode64(
bad64:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid base64 character \"%c\" at position %td",
+ "invalid base64 character \"%c\" at position %" TCL_Z_MODIFIER "d",
(char) c, data - datastart - 1));
TclDecrRefCount(resultObj);
return TCL_ERROR;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 15fefae..b624bc0 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1447,6 +1447,9 @@ StringIndexCmd(
char buf[4];
length = Tcl_UniCharToUtf(ch, buf);
+ if (!length) {
+ length = Tcl_UniCharToUtf(-1, buf);
+ }
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
}
}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 0fe7ceb..d9f0258 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -701,7 +701,7 @@ TclCompileCatchCmd(
/* Stack at this point on both branches: result returnCode */
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
- Tcl_Panic("TclCompileCatchCmd: bad jump distance %td",
+ Tcl_Panic("TclCompileCatchCmd: bad jump distance %" TCL_Z_MODIFIER "d",
(CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
@@ -1863,7 +1863,7 @@ TclCompileDictUpdateCmd(
TclEmitInvoke(envPtr,INST_RETURN_STK);
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
- Tcl_Panic("TclCompileDictCmd(update): bad jump distance %td",
+ Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - jumpFixup.codeOffset);
}
TclStackFree(interp, keyTokenPtrs);
@@ -2225,7 +2225,7 @@ TclCompileDictWithCmd(
*/
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
- Tcl_Panic("TclCompileDictCmd(update): bad jump distance %td",
+ Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - jumpFixup.codeOffset);
}
return TCL_OK;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index df512af..38839fd 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1567,7 +1567,7 @@ TclSubstCompile(
/* Start */
if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad start jump distance %td",
+ Tcl_Panic("TclCompileSubstCmd: bad start jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - startFixup.codeOffset);
}
}
@@ -1626,7 +1626,7 @@ TclSubstCompile(
TclAdjustStackDepth(1, envPtr);
/* BREAK destination */
if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad break jump distance %td",
+ Tcl_Panic("TclCompileSubstCmd: bad break jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - breakFixup.codeOffset);
}
OP( POP);
@@ -1642,7 +1642,7 @@ TclSubstCompile(
TclAdjustStackDepth(2, envPtr);
/* CONTINUE destination */
if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %td",
+ Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - continueFixup.codeOffset);
}
OP( POP);
@@ -1652,11 +1652,11 @@ TclSubstCompile(
TclAdjustStackDepth(2, envPtr);
/* RETURN + other destination */
if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad return jump distance %td",
+ Tcl_Panic("TclCompileSubstCmd: bad return jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - returnFixup.codeOffset);
}
if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad other jump distance %td",
+ Tcl_Panic("TclCompileSubstCmd: bad other jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - otherFixup.codeOffset);
}
@@ -1669,7 +1669,7 @@ TclSubstCompile(
/* OK destination */
if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %td",
+ Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - okFixup.codeOffset);
}
if (count > 1) {
@@ -1679,7 +1679,7 @@ TclSubstCompile(
/* CONTINUE jump to here */
if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad end jump distance %td",
+ Tcl_Panic("TclCompileSubstCmd: bad end jump distance %" TCL_Z_MODIFIER "d",
CurrentOffset(envPtr) - endFixup.codeOffset);
}
bline = envPtr->line;
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 8f2ff37..29ca0bf 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -64,7 +64,7 @@ static void FreeDictInternalRep(Tcl_Obj *dictPtr);
static void InvalidateDictChain(Tcl_Obj *dictObj);
static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDict(Tcl_Obj *dictPtr);
-static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr,CONST90 void *keyPtr);
+static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static inline void InitChainTable(struct Dict *dict);
static inline void DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
@@ -227,7 +227,7 @@ typedef struct {
static Tcl_HashEntry *
AllocChainEntry(
Tcl_HashTable *tablePtr,
- CONST90 void *keyPtr)
+ void *keyPtr)
{
Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
ChainEntry *cPtr;
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 77b18df..fe18119 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -894,7 +894,7 @@ PrintSourceToObj(
Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
i += 10;
} else
-#elif TCL_UTF_MAX > 3
+#else
/* If len == 0, this means we have a char > 0xffff, resulting in
* TclUtfToUniChar producing a surrogate pair. We want to output
* this pair as a single Unicode character.
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 8cc4b74..40ced17 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -723,14 +723,25 @@ TclFinalizeEnvironment(void)
* strings. This may leak more memory that strictly necessary, since some
* of the strings may no longer be in the environment. However,
* determining which ones are ok to delete is n-squared, and is pretty
- * unlikely, so we don't bother.
+ * unlikely, so we don't bother. However, in the case of DPURIFY, just
+ * free all strings in the cache.
*/
if (env.cache) {
+#ifdef PURIFY
+ int i;
+ for (i = 0; i < env.cacheSize; i++) {
+ ckfree(env.cache[i]);
+ }
+#endif
ckfree(env.cache);
env.cache = NULL;
env.cacheSize = 0;
#ifndef USE_PUTENV
+ if ((env.ourEnviron != NULL)) {
+ ckfree(env.ourEnviron);
+ env.ourEnviron = NULL;
+ }
env.ourEnvironSize = 0;
#endif
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 5b8bc01..be4a744 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4754,7 +4754,7 @@ TEBCresume(
/* Decode index value operands. */
- /*
+ /*
assert ( toIdx != TCL_INDEX_AFTER);
*
* Extra safety for legacy bytecodes:
@@ -5015,9 +5015,15 @@ TEBCresume(
* but creating the object as a string seems to be faster in
* practical use.
*/
-
- length = (ch != -1) ? Tcl_UniCharToUtf(ch, buf) : 0;
- objResultPtr = Tcl_NewStringObj(buf, length);
+ if (ch == -1) {
+ objResultPtr = Tcl_NewObj();
+ } else {
+ length = Tcl_UniCharToUtf(ch, buf);
+ if (!length) {
+ length = Tcl_UniCharToUtf(-1, buf);
+ }
+ objResultPtr = Tcl_NewStringObj(buf, length);
+ }
}
TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
diff --git a/generic/tclHash.c b/generic/tclHash.c
index dc58800..a4317e8 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -34,18 +34,18 @@
* Prototypes for the array hash key methods.
*/
-static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, CONST90 void *keyPtr);
-static int CompareArrayKeys(CONST90 void *keyPtr, Tcl_HashEntry *hPtr);
-static TCL_HASH_TYPE HashArrayKey(Tcl_HashTable *tablePtr, CONST90 void *keyPtr);
+static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
+static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static TCL_HASH_TYPE HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Prototypes for the string hash key methods.
*/
static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr,
- CONST90 void *keyPtr);
-static int CompareStringKeys(CONST90 void *keyPtr, Tcl_HashEntry *hPtr);
-static TCL_HASH_TYPE HashStringKey(Tcl_HashTable *tablePtr, CONST90 void *keyPtr);
+ void *keyPtr);
+static int CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static TCL_HASH_TYPE HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Function prototypes for static functions in this file:
@@ -619,16 +619,16 @@ Tcl_HashStats(
*/
result = ckalloc((NUM_COUNTERS * 60) + 300);
- sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" TCL_LL_MODIFIER "d buckets\n",
- (Tcl_WideInt)tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets);
+ sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
+ tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
for (i = 0; i < NUM_COUNTERS; i++) {
- sprintf(p, "number of buckets with %d entries: %" TCL_LL_MODIFIER "d\n",
- (int)i, (Tcl_WideInt)count[i]);
+ sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
+ i, count[i]);
p += strlen(p);
}
- sprintf(p, "number of buckets with %d or more entries: %d\n",
- NUM_COUNTERS, (int)overflow);
+ sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
+ NUM_COUNTERS, overflow);
p += strlen(p);
sprintf(p, "average search distance for entry: %.1f", average);
return result;
@@ -653,7 +653,7 @@ Tcl_HashStats(
static Tcl_HashEntry *
AllocArrayEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
- CONST90 void *keyPtr) /* Key to store in the hash table entry. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
int *array = (int *) keyPtr;
register int *iPtr1, *iPtr2;
@@ -697,11 +697,11 @@ AllocArrayEntry(
static int
CompareArrayKeys(
- CONST90 void *keyPtr, /* New key to compare. */
+ void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- register const int *iPtr1 = (const int *) keyPtr;
- register const int *iPtr2 = (const int *) hPtr->key.words;
+ const int *iPtr1 = keyPtr;
+ const int *iPtr2 = hPtr->key.words;
Tcl_HashTable *tablePtr = hPtr->tablePtr;
int count;
@@ -737,7 +737,7 @@ CompareArrayKeys(
static TCL_HASH_TYPE
HashArrayKey(
Tcl_HashTable *tablePtr, /* Hash table. */
- CONST90 void *keyPtr) /* Key from which to compute hash value. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
register const int *array = (const int *) keyPtr;
register TCL_HASH_TYPE result;
@@ -769,7 +769,7 @@ HashArrayKey(
static Tcl_HashEntry *
AllocStringEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
- CONST90 void *keyPtr) /* Key to store in the hash table entry. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
const char *string = (const char *) keyPtr;
Tcl_HashEntry *hPtr;
@@ -804,13 +804,10 @@ AllocStringEntry(
static int
CompareStringKeys(
- CONST90 void *keyPtr, /* New key to compare. */
+ void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- register const char *p1 = (const char *) keyPtr;
- register const char *p2 = (const char *) hPtr->key.string;
-
- return !strcmp(p1, p2);
+ return !strcmp(keyPtr, hPtr->key.string);
}
/*
@@ -833,7 +830,7 @@ CompareStringKeys(
static TCL_HASH_TYPE
HashStringKey(
Tcl_HashTable *tablePtr, /* Hash table. */
- CONST90 void *keyPtr) /* Key from which to compute hash value. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
register const char *string = keyPtr;
register TCL_HASH_TYPE result;
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 24c26f6..db124fb 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -11,7 +11,7 @@
#include "tclInt.h"
-#if defined(_WIN32) && defined(UNICODE)
+#if defined(_WIN32)
/*
* On Windows, we need to do proper Unicode->UTF-8 conversion.
*/
diff --git a/generic/tclInt.h b/generic/tclInt.h
index ecac8d1..0ba2ee7 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4024,9 +4024,9 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
* So tclObj.c and tclDictObj.c can share these implementations.
*/
-MODULE_SCOPE int TclCompareObjKeys(CONST90 void *keyPtr, Tcl_HashEntry *hPtr);
+MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr);
-MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, CONST90 void *keyPtr);
+MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
MODULE_SCOPE int TclFullFinalizationRequested(void);
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 3438e1a..6ad57b3 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -220,7 +220,7 @@ static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
* Prototypes for the array hash key methods.
*/
-static Tcl_HashEntry * AllocObjEntry(Tcl_HashTable *tablePtr, CONST90 void *keyPtr);
+static Tcl_HashEntry * AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Prototypes for the CommandName object type.
@@ -3111,8 +3111,7 @@ TclGetNumberFromObj(
}
if (objPtr->typePtr == &tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
- mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
- (int) sizeof(mp_int));
+ mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, sizeof(mp_int));
UNPACK_BIGNUM(objPtr, *bigPtr);
*typePtr = TCL_NUMBER_BIG;
@@ -3375,7 +3374,7 @@ Tcl_InitObjHashTable(
static Tcl_HashEntry *
AllocObjEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
- CONST90 void *keyPtr) /* Key to store in the hash table entry. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
@@ -3406,7 +3405,7 @@ AllocObjEntry(
int
TclCompareObjKeys(
- CONST90 void *keyPtr, /* New key to compare. */
+ void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
@@ -3496,7 +3495,7 @@ TclFreeObjEntry(
TCL_HASH_TYPE
TclHashObjKey(
Tcl_HashTable *tablePtr, /* Hash table. */
- CONST90 void *keyPtr) /* Key from which to compute hash value. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
const char *string = TclGetString(objPtr);
@@ -3914,10 +3913,10 @@ Tcl_RepresentationCmd(
* "1872361827361287"
*/
- descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
+ descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "d,"
" object pointer at %p",
objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
- (int) objv[1]->refCount, objv[1]);
+ objv[1]->refCount, objv[1]);
if (objv[1]->typePtr) {
if (objv[1]->typePtr == &tclDoubleType) {
diff --git a/generic/tclParse.c b/generic/tclParse.c
index ca10b89..4e83ae2 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -980,7 +980,12 @@ TclParseBackslash(
if (readPtr != NULL) {
*readPtr = count;
}
- return Tcl_UniCharToUtf(result, dst);
+ count = Tcl_UniCharToUtf(result, dst);
+ if (!count) {
+ /* Special case for handling upper surrogates. */
+ count = Tcl_UniCharToUtf(-1, dst);
+ }
+ return count;
}
/*
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 4d30374..34474f1 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -536,7 +536,7 @@ Tcl_GetUniChar(
return -1;
}
- return (int) bytes[index];
+ return bytes[index];
}
/*
@@ -683,9 +683,6 @@ Tcl_GetRange(
String *stringPtr;
int length;
- if (last == (size_t)-2) {
- last = (size_t)-1; /* For compatibility with pre-9.0 behavior */
- }
if (first == (size_t)-1) {
first = 0;
}
@@ -698,10 +695,10 @@ Tcl_GetRange(
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
- if (last+1 >= (size_t)(unsigned int)length+1) {
+ if (last+2 >= (size_t)(unsigned int)length+2) {
last = length - 1;
}
- if (last + 1 < first + 1) {
+ if (last + 2 < first + 2) {
return Tcl_NewObj();
}
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
@@ -723,10 +720,10 @@ Tcl_GetRange(
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
- if (last + 1 >= stringPtr->numChars + 1) {
+ if (last + 2 >= stringPtr->numChars + 2) {
last = stringPtr->numChars - 1;
}
- if (last + 1 < first + 1) {
+ if (last + 2 < first + 2) {
return Tcl_NewObj();
}
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
@@ -743,10 +740,10 @@ Tcl_GetRange(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
- if (last + 1 > stringPtr->numChars + 1) {
+ if (last + 2 > stringPtr->numChars + 2) {
last = stringPtr->numChars;
}
- if (last + 1 < first + 1) {
+ if (last + 2 < first + 2) {
return Tcl_NewObj();
}
#if TCL_UTF_MAX <= 4
@@ -755,7 +752,7 @@ Tcl_GetRange(
&& ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
++first;
}
- if ((last + 1 < stringPtr->numChars)
+ if ((last + 2 < stringPtr->numChars + 1)
&& ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
++last;
@@ -1995,6 +1992,10 @@ Tcl_AppendFormatToObj(
goto error;
}
length = Tcl_UniCharToUtf(code, buf);
+ if (!length) {
+ /* Special case for handling upper surrogates. */
+ length = Tcl_UniCharToUtf(-1, buf);
+ }
segment = Tcl_NewStringObj(buf, length);
Tcl_IncrRefCount(segment);
allocSegment = 1;
@@ -2124,7 +2125,7 @@ Tcl_AppendFormatToObj(
const char *bytes;
if (useShort) {
- pure = Tcl_NewIntObj((int) s);
+ pure = Tcl_NewIntObj(s);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
@@ -2255,9 +2256,9 @@ Tcl_AppendFormatToObj(
numDigits = 1;
}
pure = Tcl_NewObj();
- Tcl_SetObjLength(pure, (int) numDigits);
+ Tcl_SetObjLength(pure, numDigits);
bytes = TclGetString(pure);
- toAppend = length = (int) numDigits;
+ toAppend = length = numDigits;
while (numDigits--) {
int digitOffset;
@@ -2269,7 +2270,7 @@ Tcl_AppendFormatToObj(
}
shift -= numBits;
}
- digitOffset = (int) (bits % base);
+ digitOffset = bits % base;
if (digitOffset > 9) {
if (ch == 'X') {
bytes[numDigits] = 'A' + digitOffset - 10;
@@ -2561,7 +2562,7 @@ AppendPrintfToObjVA(
*/
q = Tcl_UtfPrev(end, bytes);
- if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
+ if (!Tcl_UtfCharComplete(q, (end - q))) {
end = q;
}
@@ -2572,7 +2573,7 @@ AppendPrintfToObjVA(
}
Tcl_ListObjAppendElement(NULL, list,
- Tcl_NewStringObj(bytes , (int)(end - bytes)));
+ Tcl_NewStringObj(bytes , (end - bytes)));
break;
}
@@ -2622,7 +2623,7 @@ AppendPrintfToObjVA(
seekingConversion = 0;
break;
case '*':
- lastNum = (int) va_arg(argList, int);
+ lastNum = va_arg(argList, int);
Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
p++;
break;
@@ -2630,7 +2631,7 @@ AppendPrintfToObjVA(
case '5': case '6': case '7': case '8': case '9': {
char *end;
- lastNum = (int) strtoul(p, &end, 10);
+ lastNum = strtoul(p, &end, 10);
p = end;
break;
}
@@ -4210,7 +4211,7 @@ ExtendStringRepWithUnicode(
copyBytes:
dst = objPtr->bytes + origLength;
for (i = 0; i < numChars; i++) {
- dst += Tcl_UniCharToUtf((int) unicode[i], dst);
+ dst += Tcl_UniCharToUtf(unicode[i], dst);
}
*dst = '\0';
objPtr->length = dst - objPtr->bytes;
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 3a6fc43..1742eb7 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -174,7 +174,6 @@ TclThread_Init(
Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
@@ -1158,6 +1157,14 @@ ThreadExitProc(
Tcl_MutexLock(&threadMutex);
+ if (self == errorThreadId) {
+ if (errorProcString) { /* Extra safety */
+ ckfree(errorProcString);
+ errorProcString = NULL;
+ }
+ errorThreadId = 0;
+ }
+
if (threadEvalScript) {
ckfree(threadEvalScript);
threadEvalScript = NULL;
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 4cbe31c..e9aab51 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -173,6 +173,13 @@ Tcl_UniCharToUtf(
buf[0] = (char) ((ch >> 18) | 0xF0);
return 4;
}
+ } else if (ch == -1) {
+ if (((buf[0] & 0xF8) == 0xF0) && ((buf[1] & 0xC0) == 0x80)
+ && ((buf[2] & 0xCF) == 0)) {
+ ch = 0xD7C0 + ((buf[0] & 0x07) << 8) + ((buf[1] & 0x3F) << 2)
+ + ((buf[2] & 0x30) >> 4);
+ goto three;
+ }
}
ch = 0xFFFD;
@@ -212,6 +219,7 @@ Tcl_UniCharToUtfDString(
const Tcl_UniChar *w, *wEnd;
char *p, *string;
size_t oldLength;
+ int len = 1;
/*
* UTF-8 string length in bytes will be <= Unicode string length * 4.
@@ -224,9 +232,18 @@ Tcl_UniCharToUtfDString(
p = string;
wEnd = uniStr + uniLength;
for (w = uniStr; w < wEnd; ) {
- p += Tcl_UniCharToUtf(*w, p);
+ if (!len && ((*w & 0xFC00) != 0xDC00)) {
+ /* Special case for handling upper surrogates. */
+ p += Tcl_UniCharToUtf(-1, p);
+ }
+ len = Tcl_UniCharToUtf(*w, p);
+ p += len;
w++;
}
+ if (!len) {
+ /* Special case for handling upper surrogates. */
+ p += Tcl_UniCharToUtf(-1, p);
+ }
Tcl_DStringSetLength(dsPtr, oldLength + (p - string));
return string;
@@ -899,7 +916,7 @@ Tcl_UtfToUpper(
* char to dst if its size is <= the original char.
*/
- if (bytes < TclUtfCount(upChar)) {
+ if ((bytes < TclUtfCount(upChar)) || ((upChar & 0xF800) == 0xD800)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -962,7 +979,7 @@ Tcl_UtfToLower(
* char to dst if its size is <= the original char.
*/
- if (bytes < TclUtfCount(lowChar)) {
+ if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -1022,7 +1039,7 @@ Tcl_UtfToTitle(
#endif
titleChar = Tcl_UniCharToTitle(titleChar);
- if (bytes < TclUtfCount(titleChar)) {
+ if ((bytes < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -1046,7 +1063,7 @@ Tcl_UtfToTitle(
lowChar = Tcl_UniCharToLower(lowChar);
}
- if (bytes < TclUtfCount(lowChar)) {
+ if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 65dc55c..c85f33d 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1907,7 +1907,7 @@ TclTrim(
*/
/* The whitespace characters trimmed during [concat] operations */
-#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)
+#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1)
char *
Tcl_Concat(
@@ -3535,7 +3535,7 @@ GetEndOffsetFromObj(
/* TODO: Handle overflow cases sensibly */
*indexPtr = endValue + (int)objPtr->internalRep.wideValue;
- if ((*indexPtr < -1) && (endValue < 0)) *indexPtr = -1;
+ if ((*indexPtr < -1) && (endValue > 0)) *indexPtr = -1;
return TCL_OK;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 3bae78f..12e3640 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -24,9 +24,9 @@
* Prototypes for the variable hash key methods.
*/
-static Tcl_HashEntry * AllocVarEntry(Tcl_HashTable *tablePtr, CONST90 void *keyPtr);
+static Tcl_HashEntry * AllocVarEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static void FreeVarEntry(Tcl_HashEntry *hPtr);
-static int CompareVarKeys(CONST90 void *keyPtr, Tcl_HashEntry *hPtr);
+static int CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static const Tcl_HashKeyType tclVarHashKeyType = {
TCL_HASH_KEY_TYPE_VERSION, /* version */
@@ -6389,7 +6389,7 @@ TclInitVarHashTable(
static Tcl_HashEntry *
AllocVarEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
- CONST90 void *keyPtr) /* Key to store in the hash table entry. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
Tcl_HashEntry *hPtr;
@@ -6428,7 +6428,7 @@ FreeVarEntry(
static int
CompareVarKeys(
- CONST90 void *keyPtr, /* New key to compare. */
+ void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
generated by cgit v0.12 at 2025-03-26 04:34:21 (GMT)