diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2021-03-04 12:24:33 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2021-03-04 12:24:33 (GMT) |
commit | 3a980dd3a7bc53bdc54f7d0d6a2da71d24a53792 (patch) | |
tree | 9326b1f70d9f47218e4781465c4bb2b77b9b3650 | |
parent | 19ee2fb547272b89b6792f67296c11e174f72a68 (diff) | |
parent | 6f77d31f1bacd7f1f6fefce74af42b5101402b3a (diff) | |
download | tcl-3a980dd3a7bc53bdc54f7d0d6a2da71d24a53792.zip tcl-3a980dd3a7bc53bdc54f7d0d6a2da71d24a53792.tar.gz tcl-3a980dd3a7bc53bdc54f7d0d6a2da71d24a53792.tar.bz2 |
Merge 9.0
-rw-r--r-- | doc/StaticLibrary.3 | 45 | ||||
-rw-r--r-- | doc/msgcat.n | 2 | ||||
-rw-r--r-- | generic/tcl.decls | 5 | ||||
-rw-r--r-- | generic/tcl.h | 12 | ||||
-rw-r--r-- | generic/tclAlloc.c | 10 | ||||
-rw-r--r-- | generic/tclDecls.h | 12 | ||||
-rw-r--r-- | generic/tclInt.decls | 1 | ||||
-rw-r--r-- | generic/tclStubInit.c | 4 | ||||
-rw-r--r-- | generic/tclThreadAlloc.c | 53 | ||||
-rw-r--r-- | generic/tclTomMath.decls | 1 | ||||
-rw-r--r-- | generic/tclUtf.c | 6 | ||||
-rw-r--r-- | tests/utf.test | 79 | ||||
-rw-r--r-- | tools/genStubs.tcl | 2 |
13 files changed, 151 insertions, 81 deletions
diff --git a/doc/StaticLibrary.3 b/doc/StaticLibrary.3 index 6dd23fb..35cd5f3 100644 --- a/doc/StaticLibrary.3 +++ b/doc/StaticLibrary.3 @@ -8,44 +8,44 @@ .so man.macros .BS .SH NAME -Tcl_StaticLibrary \- make a statically linked package available via the 'load' command +Tcl_StaticLibrary \- make a statically linked library available via the 'load' command .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp -\fBTcl_StaticLibrary\fR(\fIinterp, pkgName, initProc, safeInitProc\fR) +\fBTcl_StaticLibrary\fR(\fIinterp, prefix, initProc, safeInitProc\fR) .SH ARGUMENTS .AS Tcl_LibraryInitProc *safeInitProc .AP Tcl_Interp *interp in -If not NULL, points to an interpreter into which the package has -already been loaded (i.e., the caller has already invoked the -appropriate initialization procedure). NULL means the package +If not NULL, points to an interpreter into which the library has +already been incorporated (i.e., the caller has already invoked the +appropriate initialization procedure). NULL means the library has not yet been incorporated into any interpreter. -.AP "const char" *pkgName in -Name of the package; should be properly capitalized (first letter -upper-case, all others lower-case). +.AP "const char" *prefix in +Prefix for library initialization function. Normally in titlecase (first +letter upper-case, all others lower-case), but this is no longer required. .AP Tcl_LibraryInitProc *initProc in -Procedure to invoke to incorporate this package into a trusted +Procedure to invoke to incorporate this library into a trusted interpreter. .AP Tcl_LibraryInitProc *safeInitProc in -Procedure to call to incorporate this package into a safe interpreter -(one that will execute untrusted scripts). NULL means the package +Procedure to call to incorporate this library into a safe interpreter +(one that will execute untrusted scripts). NULL means the library cannot be used in safe interpreters. .BE .SH DESCRIPTION .PP -This procedure may be invoked to announce that a package has been +This procedure may be invoked to announce that a library has been linked statically with a Tcl application and, optionally, that it -has already been loaded into an interpreter. -Once \fBTcl_StaticLibrary\fR has been invoked for a package, it -may be loaded into interpreters using the \fBload\fR command. +has already been incorporated into an interpreter. +Once \fBTcl_StaticLibrary\fR has been invoked for a library, it +may be incorporated into interpreters using the \fBload\fR command. \fBTcl_StaticLibrary\fR is normally invoked only by the \fBTcl_AppInit\fR -procedure for the application, not by packages for themselves +procedure for the application, not by libraries for themselves (\fBTcl_StaticLibrary\fR should only be invoked for statically -loaded packages, and code in the package itself should not need -to know whether the package is dynamically or statically loaded). +linked libraries, and code in the library itself should not need +to know whether the library is dynamically loaded or statically linked). .PP -When the \fBload\fR command is used later to load the package into +When the \fBload\fR command is used later to incorporate the library into an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will be invoked, depending on whether the target interpreter is safe or not. @@ -57,8 +57,8 @@ typedef int \fBTcl_LibraryInitProc\fR( Tcl_Interp *\fIinterp\fR); .CE .PP -The \fIinterp\fR argument identifies the interpreter in which the package -is to be loaded. The initialization procedure must return \fBTCL_OK\fR or +The \fIinterp\fR argument identifies the interpreter in which the library +is to be incorporated. The initialization procedure must return \fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed successfully; in the event of an error it should set the interpreter's result to point to an error message. The result or error from the initialization procedure will @@ -67,6 +67,9 @@ initialization procedure to be invoked. .PP \fBTcl_StaticLibrary\fR can not be safely used by stub-enabled extensions, so its symbol is not included in the stub table. +.PP +\fBTcl_StaticLibrary\fR was named \fBTcl_StaticPackage\fR in Tcl 8.6 and +earlier, but the old name is deprecated now. .SH KEYWORDS initialization procedure, package, static linking .SH "SEE ALSO" diff --git a/doc/msgcat.n b/doc/msgcat.n index 74a7020..1384fa8 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -219,7 +219,7 @@ As an example, the user may prefer French or English text. This may be configure .PP .VS "TIP 499" .TP -\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR? +\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR? . This group of commands manage the list of loaded locales for packages not setting a package locale. .PP diff --git a/generic/tcl.decls b/generic/tcl.decls index 7521e4b..22aa31c 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2475,6 +2475,9 @@ declare 652 { declare 653 { unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) } +declare 656 { + void TclUnusedStubEntry(void) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # @@ -2544,7 +2547,7 @@ export { export { void Tcl_InitSubsystems(void) } -export { +export { int TclZipfs_AppHook(int *argc, char ***argv) } diff --git a/generic/tcl.h b/generic/tcl.h index b9a2142..531d289 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -576,9 +576,11 @@ typedef void (Tcl_ServiceModeHookProc) (int mode); typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); - -#define Tcl_PackageInitProc Tcl_LibraryInitProc -#define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc + +#ifndef TCL_NO_DEPRECATED +# define Tcl_PackageInitProc Tcl_LibraryInitProc +# define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc +#endif /* *---------------------------------------------------------------------------- @@ -2195,7 +2197,9 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, const char *pkgName, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); -#define Tcl_StaticPackage Tcl_StaticLibrary +#ifndef TCL_NO_DEPRECATED +# define Tcl_StaticPackage Tcl_StaticLibrary +#endif EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); #ifdef _WIN32 EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv); diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 5070f96..8b50ffd 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -94,7 +94,7 @@ union overhead { #define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (13 - (MINBLOCK >> 4)) -#define MAXMALLOC (1<<(NBUCKETS+2)) +#define MAXMALLOC ((size_t)1 << (NBUCKETS+2)) static union overhead *nextf[NBUCKETS]; /* @@ -582,7 +582,7 @@ TclpRealloc( Tcl_MutexUnlock(allocMutexPtr); return (void *)(overPtr+1); } - maxSize = 1 << (i+3); + maxSize = (size_t)1 << (i+3); expensive = 0; if (numBytes+OVERHEAD > maxSize) { expensive = 1; @@ -655,18 +655,18 @@ mstats( for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) { fprintf(stderr, " %u", j); } - totalFree += ((size_t)j) * (1 << (i + 3)); + totalFree += ((size_t)j) * ((size_t)1 << (i + 3)); } fprintf(stderr, "\nused:\t"); for (i = 0; i < NBUCKETS; i++) { fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]); - totalUsed += numMallocs[i] * (1 << (i + 3)); + totalUsed += numMallocs[i] * ((size_t)1 << (i + 3)); } fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n", totalUsed, totalFree); - fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n", + fprintf(stderr, "\n\tNumber of big (>%" TCL_Z_MODIFIER "u) blocks in use: %" TCL_Z_MODIFIER "u\n", MAXMALLOC, numMallocs[NBUCKETS]); Tcl_MutexUnlock(allocMutexPtr); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index e454a0d..a2e6702 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1740,6 +1740,10 @@ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, /* 653 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lengthPtr); +/* Slot 654 is reserved */ +/* Slot 655 is reserved */ +/* 656 */ +EXTERN void TclUnusedStubEntry(void); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2405,6 +2409,9 @@ typedef struct TclStubs { char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 653 */ + void (*reserved654)(void); + void (*reserved655)(void); + void (*tclUnusedStubEntry) (void); /* 656 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3661,11 +3668,16 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetUnicodeFromObj) /* 652 */ #define Tcl_GetByteArrayFromObj \ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 653 */ +/* Slot 654 is reserved */ +/* Slot 655 is reserved */ +#define TclUnusedStubEntry \ + (tclStubsPtr->tclUnusedStubEntry) /* 656 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ +#undef TclUnusedStubEntry #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp # undef Tcl_Init diff --git a/generic/tclInt.decls b/generic/tclInt.decls index bd5bd14..8ba244b 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -17,6 +17,7 @@ library tcl # Define the unsupported generic interfaces. interface tclInt +scspec EXTERN # Declare each of the functions in the unsupported internal Tcl # interface. These interfaces are allowed to changed between versions. diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index a34cd17..d8b614d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -66,6 +66,7 @@ #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar +#define TclUnusedStubEntry 0 #if TCL_UTF_MAX <= 3 static void uniCodePanic() { @@ -1414,6 +1415,9 @@ const TclStubs tclStubs = { Tcl_GetStringFromObj, /* 651 */ Tcl_GetUnicodeFromObj, /* 652 */ Tcl_GetByteArrayFromObj, /* 653 */ + 0, /* 654 */ + 0, /* 655 */ + TclUnusedStubEntry, /* 656 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 9749807..f343196 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -91,9 +91,8 @@ typedef struct { size_t numRemoves; /* Number of removes from bucket */ size_t numInserts; /* Number of inserts into bucket */ - size_t numWaits; /* Number of waits to acquire a lock */ size_t numLocks; /* Number of locks acquired */ - size_t totalAssigned; /* Total space assigned to bucket */ + size_t totalAssigned; /* Total space assigned to bucket */ } Bucket; /* @@ -107,9 +106,9 @@ typedef struct Cache { struct Cache *nextPtr; /* Linked list of cache entries */ Tcl_ThreadId owner; /* Which thread's cache is this? */ Tcl_Obj *firstObjPtr; /* List of free objects for thread */ - int numObjects; /* Number of objects for thread */ + size_t numObjects; /* Number of objects for thread */ Tcl_Obj *lastPtr; /* Last object in this cache */ - int totalAssigned; /* Total space assigned to thread */ + size_t totalAssigned; /* Total space assigned to thread */ Bucket buckets[NBUCKETS]; /* The buckets for this thread */ } Cache; @@ -132,12 +131,12 @@ static struct { static Cache * GetCache(void); static void LockBucket(Cache *cachePtr, int bucket); static void UnlockBucket(Cache *cachePtr, int bucket); -static void PutBlocks(Cache *cachePtr, int bucket, int numMove); +static void PutBlocks(Cache *cachePtr, int bucket, size_t numMove); static int GetBlocks(Cache *cachePtr, int bucket); static Block * Ptr2Block(void *ptr); -static void * Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize); -static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove); -static void PutObjs(Cache *fromPtr, int numMove); +static void * Block2Ptr(Block *blockPtr, int bucket, size_t reqSize); +static void MoveObjs(Cache *fromPtr, Cache *toPtr, size_t numMove); +static void PutObjs(Cache *fromPtr, size_t numMove); /* * Local variables defined in this file and initialized at startup. @@ -522,7 +521,7 @@ TclThreadAllocObj(void) */ if (cachePtr->numObjects == 0) { - int numMove; + size_t numMove; Tcl_MutexLock(objLockPtr); numMove = sharedPtr->numObjects; @@ -539,11 +538,11 @@ TclThreadAllocObj(void) cachePtr->numObjects = numMove = NOBJALLOC; newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove); if (newObjsPtr == NULL) { - Tcl_Panic("alloc: could not allocate %d new objects", numMove); + Tcl_Panic("alloc: could not allocate %ld new objects", numMove); } cachePtr->lastPtr = newObjsPtr + numMove - 1; objPtr = cachePtr->firstObjPtr; /* NULL */ - while (--numMove >= 0) { + while (numMove-- > 0) { newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr; objPtr = newObjsPtr + numMove; } @@ -645,14 +644,14 @@ Tcl_GetMemoryInfo( Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { - sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u", + sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" + TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u", bucketInfo[n].blockSize, cachePtr->buckets[n].numFree, cachePtr->buckets[n].numRemoves, cachePtr->buckets[n].numInserts, cachePtr->buckets[n].totalAssigned, - cachePtr->buckets[n].numLocks, - cachePtr->buckets[n].numWaits); + cachePtr->buckets[n].numLocks); Tcl_DStringAppendElement(dsPtr, buf); } Tcl_DStringEndSublist(dsPtr); @@ -681,7 +680,7 @@ static void MoveObjs( Cache *fromPtr, Cache *toPtr, - int numMove) + size_t numMove) { Tcl_Obj *objPtr = fromPtr->firstObjPtr; Tcl_Obj *fromFirstObjPtr = objPtr; @@ -694,7 +693,7 @@ MoveObjs( * to be moved) as the first object in the 'from' cache. */ - while (--numMove) { + while (numMove-- > 1) { objPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1; } fromPtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1; @@ -728,9 +727,9 @@ MoveObjs( static void PutObjs( Cache *fromPtr, - int numMove) + size_t numMove) { - int keep = fromPtr->numObjects - numMove; + size_t keep = fromPtr->numObjects - numMove; Tcl_Obj *firstPtr, *lastPtr = NULL; fromPtr->numObjects = keep; @@ -741,7 +740,7 @@ PutObjs( do { lastPtr = firstPtr; firstPtr = (Tcl_Obj *)firstPtr->internalRep.twoPtrValue.ptr1; - } while (--keep > 0); + } while (keep-- > 1); lastPtr->internalRep.twoPtrValue.ptr1 = NULL; } @@ -782,7 +781,7 @@ static void * Block2Ptr( Block *blockPtr, int bucket, - unsigned int reqSize) + size_t reqSize) { void *ptr; @@ -872,14 +871,14 @@ static void PutBlocks( Cache *cachePtr, int bucket, - int numMove) + size_t numMove) { /* * We have numFree. Want to shed numMove. So compute how many * Blocks to keep. */ - int keep = cachePtr->buckets[bucket].numFree - numMove; + size_t keep = cachePtr->buckets[bucket].numFree - numMove; Block *lastPtr = NULL, *firstPtr; cachePtr->buckets[bucket].numFree = keep; @@ -890,7 +889,7 @@ PutBlocks( do { lastPtr = firstPtr; firstPtr = firstPtr->nextBlock; - } while (--keep > 0); + } while (keep-- > 1); lastPtr->nextBlock = NULL; } @@ -968,7 +967,7 @@ GetBlocks( cachePtr->buckets[bucket].firstPtr = blockPtr; sharedPtr->buckets[bucket].numFree -= n; cachePtr->buckets[bucket].numFree = n; - while (--n > 0) { + while (n-- > 1) { blockPtr = blockPtr->nextBlock; } sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock; @@ -990,7 +989,7 @@ GetBlocks( blockPtr = NULL; n = NBUCKETS; size = 0; - while (--n > (size_t)bucket) { + while (n-- > (size_t)bucket + 1) { if (cachePtr->buckets[n].numFree > 0) { size = bucketInfo[n].blockSize; blockPtr = cachePtr->buckets[n].firstPtr; @@ -1019,7 +1018,7 @@ GetBlocks( n = size / bucketInfo[bucket].blockSize; cachePtr->buckets[bucket].numFree = n; cachePtr->buckets[bucket].firstPtr = blockPtr; - while (--n > 0) { + while (n-- > 1) { blockPtr->nextBlock = (Block *) ((char *) blockPtr + bucketInfo[bucket].blockSize); blockPtr = blockPtr->nextBlock; @@ -1058,7 +1057,7 @@ TclInitThreadAlloc(void) bucketInfo[i].blockSize = MINALLOC << i; bucketInfo[i].maxBlocks = ((size_t)1) << (NBUCKETS - 1 - i); bucketInfo[i].numMove = i < NBUCKETS - 1 ? - 1 << (NBUCKETS - 2 - i) : 1; + (size_t)1 << (NBUCKETS - 2 - i) : 1; bucketInfo[i].lockPtr = TclpNewAllocMutex(); } TclpInitAllocCache(); diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index ea310e0..9c5ca8b 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -17,7 +17,6 @@ library tcl # Define the unsupported generic interfaces. interface tclTomMath -# hooks {tclTomMathInt} scspec EXTERN # Declare each of the functions in the Tcl tommath interface diff --git a/generic/tclUtf.c b/generic/tclUtf.c index fde30c5..f56abd8 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -92,6 +92,8 @@ static const unsigned char complete[256] = { #if TCL_UTF_MAX > 3 4,4,4,4,4, #else + /* Tcl_UtfToUniChar() accesses src[1] and src[2] to check whether + * the UTF-8 sequence is valid, so we cannot use 1 here. */ 3,3,3,3,3, #endif 1,1,1,1,1,1,1,1,1,1,1 @@ -971,6 +973,10 @@ Tcl_UtfNext( const char *next; if (((*src) & 0xC0) == 0x80) { + /* Continuation byte, so we start 'inside' a (possible valid) UTF-8 + * sequence. Since we are not allowed to access src[-1], we cannot + * check if the sequence is actually valid, the best we can do is + * just assume it is valid and locate the end. */ if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) { ++src; } diff --git a/tests/utf.test b/tests/utf.test index 32b12c7..75f66b3 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -79,7 +79,10 @@ test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4bytes testbytestring} { expr {"\uD842\uDC42" eq [testbytestring \xF0\xA0\xA1\x82]} } 1 -test utf-1.13 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc testbytestring} { +test utf-1.13.0 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc ucs2} { + expr {"\UD842" eq "\uD842"} +} 1 +test utf-1.13.1 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc testbytestring fullutf} { expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]} } 1 @@ -104,16 +107,22 @@ test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestrin test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring { string length [testbytestring \xE4\xB9\x8E] } 1 -test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2_utf16} { +test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} { string length [testbytestring \xF0\x90\x80\x80] } 2 -test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs4} { - string length [testbytestring \xF0\x90\x80\x80] +test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc utf16} { + string length \U010000 +} 2 +test utf-2.8.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} { + string length \U010000 } 1 test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} { string length [testbytestring \xF4\x8F\xBF\xBF] } 2 -test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} { +test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc utf16} { + string length \U10FFFF +} 2 +test utf-2.9.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} { string length \U10FFFF } 1 test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring { @@ -216,7 +225,10 @@ test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring} { test utf-6.10 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0]G } 1 -test utf-6.11 {Tcl_UtfNext} {testutfnext testbytestring} { +test utf-6.11.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { + testutfnext [testbytestring \xA0\xA0\x00] +} 1 +test utf-6.11.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\x00] } 2 test utf-6.12 {Tcl_UtfNext} {testutfnext testbytestring} { @@ -477,10 +489,16 @@ test utf-6.87.0 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring u test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs4} { testutfnext [testbytestring \xF0\x90\x80\x80] } 4 -test utf-6.88 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring} { +test utf-6.88.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring ucs2} { + testutfnext [testbytestring \xA0\xA0\x00] +} 1 +test utf-6.88.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xA0\x00] } 2 -test utf-6.89 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring} { +test utf-6.89.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring ucs2} { + testutfnext [testbytestring \x80\x80\x00] +} 1 +test utf-6.89.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring} { testutfnext [testbytestring \x80\x80\x00] } 2 test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2_utf16} { @@ -492,16 +510,28 @@ test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbyte test utf-6.91 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring} { testutfnext [testbytestring \xF4\x90\x80\x80] } 1 -test utf-6.92 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring} { +test utf-6.92.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring ucs2} { + testutfnext [testbytestring \xA0\xA0\xA0] +} 1 +test utf-6.92.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xA0\xA0] } 3 -test utf-6.93 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring} { +test utf-6.93.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring ucs2} { + testutfnext [testbytestring \x80\x80\x80] +} 1 +test utf-6.93.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring} { testutfnext [testbytestring \x80\x80\x80] } 3 -test utf-6.94 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} { +test utf-6.94.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} { + testutfnext [testbytestring \xA0\xA0\xA0\xA0] +} 1 +test utf-6.94.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xA0\xA0\xA0] } 3 -test utf-6.95 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} { +test utf-6.95.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} { + testutfnext [testbytestring \x80\x80\x80\x80] +} 1 +test utf-6.95.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} { testutfnext [testbytestring \x80\x80\x80\x80] } 3 @@ -673,7 +703,10 @@ test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { testutfprev A[testbytestring \xF8\xA0\xA0\xA0] } 2 -test utf-7.20 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { +test utf-7.20.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF2\xA0\xA0\xA0] +} 4 +test utf-7.20.1 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { testutfprev A[testbytestring \xF2\xA0\xA0\xA0] } 2 test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { @@ -736,7 +769,10 @@ test utf-7.37 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { test utf-7.38 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] 2 } 1 -test utf-7.39 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring utf16} { +test utf-7.39.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF0\x90\x80\x80] +} 4 +test utf-7.39.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring utf16} { testutfprev A[testbytestring \xF0\x90\x80\x80] } 2 test utf-7.40.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { @@ -775,22 +811,25 @@ test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} tes test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} { testutfprev [testbytestring \xE8\xA0\x00] 2 } 0 -test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} { +test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF4\x8F\xBF\xBF] +} 4 +test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] } 2 -test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { +test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 } 3 -test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { +test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 } 1 -test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { +test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 } 2 -test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { +test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 } 1 -test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { +test utf-7.48.6 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 2 } 1 test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} { diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 47b8ad4..4f4acbb 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -1214,7 +1214,7 @@ proc genStubs::init {} { # Results: # Returns any values that were not assigned to variables. -if {[string length [namespace which lassign]] == 0} { +if {[namespace which lassign] ne ""} { proc lassign {valueList args} { if {[llength $args] == 0} { error "wrong # args: should be \"lassign list varName ?varName ...?\"" |