diff options
author | dgp <dgp@users.sourceforge.net> | 2021-04-03 20:21:57 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2021-04-03 20:21:57 (GMT) |
commit | 952f453bba44d28baab4aace4f3fcb25753ab22d (patch) | |
tree | 81399e9594c6d379dc2a1cc39d5ecf2608056405 | |
parent | efe9cf9a790e61bda8164340c3eddfa8ae36b054 (diff) | |
parent | 8b11f08b3cb7e5e92dd7812df02e8419e49be96d (diff) | |
download | tcl-952f453bba44d28baab4aace4f3fcb25753ab22d.zip tcl-952f453bba44d28baab4aace4f3fcb25753ab22d.tar.gz tcl-952f453bba44d28baab4aace4f3fcb25753ab22d.tar.bz2 |
merge trunk
70 files changed, 3238 insertions, 2677 deletions
@@ -22,6 +22,10 @@ of one or more subprocesses to execute. The arguments take the form of a standard shell pipeline where each \fIarg\fR becomes one word of a command, and each distinct command becomes a subprocess. +The result of the command is the standard output of the final subprocess in +the pipeline, interpreted using the system \fBencoding\fR; to use any other +encoding (especially including binary data), the pipeline must be +\fBopen\fRed, configured and read explicitly. .PP If the initial arguments to \fBexec\fR start with \fB\-\fR then they are treated as command-line switches and are not part @@ -411,7 +415,9 @@ With the file \fIcmp.bat\fR looking something like: .CS @gcc %* .CE +.PP or like another variant using single parameters: +.PP .CS @gcc %1 %2 %3 %4 %5 %6 %7 %8 %9 .CE @@ -72,7 +72,7 @@ indicate that the opened channel should be configured as if with the reading or writing of binary data. .PP In the second form, \fIaccess\fR consists of a list of any of the -following flags, all of which have the standard POSIX meanings. +following flags, most of which have the standard POSIX meanings. One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR. .TP 15 \fBRDONLY\fR @@ -453,6 +453,12 @@ application are competing for the console at the same time. If the command pipeline is started from a script, so that Tcl is not accessing the console, or if the command pipeline does not use standard input or output, but is redirected from or to a file, then the above problems do not occur. +.PP +Files opened in the +.QW \fBa\fR +mode or with the \fBAPPEND\fR flag set are implemented by seeking immediately +before each write, which is not an atomic operation and does not carry the +guarantee of strict appending that is present on POSIX platforms. .RE .TP \fBUnix\fR\0\0\0\0\0\0\0 @@ -527,6 +533,19 @@ Note that the equivalent options exist on Unix, but are on the serial channel type. .VE "8.7, TIP 160" .SH "EXAMPLES" +Open a file for writing, forcing it to be created and raising an error if it +already exists. +.PP +.CS +set myNewFile [\fBopen\fR filename.txt {WRONLY CREAT EXCL}] +.CE +.PP +Open a file for writing as a log file. +.PP +.CS +set myLogFile [\fBopen\fR filename.log "a"] +fconfigure $myLogFile -buffering line +.CE .PP Open a command pipeline and catch any errors: .PP @@ -538,6 +557,18 @@ if {[catch {close $fl} err]} { } .CE .PP +Open a command pipeline and read binary data from it. Note the unusual form +with +.QW |[list +that handles non-trivial edge cases with arguments that potentially have +spaces in. +.PP +.CS +set fl [\fBopen\fR |[list create_image_data $input] "rb"] +set binData [read $fl] +close $fl +.CE +.PP .VS "8.7, TIP 160" Read a password securely from the user (assuming that the script is being run interactively): diff --git a/doc/refchan.n b/doc/refchan.n index 8737556..c17117d 100644 --- a/doc/refchan.n +++ b/doc/refchan.n @@ -322,6 +322,19 @@ invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE +.TP +\fIcmdPrefix \fBtruncate\fR \fIchannelId length\fR +. +This \fIoptional\fR subcommand handles changing the length of the +underlying data stream for the channel \fIchannelId\fR. Its length +gets set to \fIlength\fR. +.RS +.PP +If the subcommand throws an error the command which caused its +invocation (usually \fBchan truncate\fR) will appear to have thrown +this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, +etc.) is treated as and converted to an error. +.RE .SH NOTES Some of the functions supported in channels defined in Tcl's C interface are not available to channels reflected to the Tcl level. diff --git a/generic/tcl.h b/generic/tcl.h index 1ae0785..e732b59 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -576,6 +576,11 @@ typedef void (Tcl_ServiceModeHookProc) (int mode); typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); + +/* Undocumented. To be formalized by TIP #595 */ +#define Tcl_LibraryInitProc Tcl_PackageInitProc +#define Tcl_LibraryUnloadProc Tcl_PackageUnloadProc +#define Tcl_StaticLibrary Tcl_StaticPackage /* *---------------------------------------------------------------------------- diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 8b50ffd..8b1bd74 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -749,6 +749,8 @@ TclpRealloc( } #endif /* !USE_TCLALLOC */ +#else +TCL_MAC_EMPTY_FILE(generic_tclAlloc_c) #endif /* !TCL_THREADS */ /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b90e12d..ce8c4ed 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3662,7 +3662,7 @@ CallCommandTraces( */ cmdPtr->flags &= ~CMD_TRACE_ACTIVE; - cmdPtr->refCount--; + TclCleanupCommandMacro(cmdPtr); iPtr->activeCmdTracePtr = active.nextPtr; Tcl_Release(iPtr); return result; diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 1bc1360..1c03fec 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -510,9 +510,11 @@ FillEncodingFileMap(void) *--------------------------------------------------------------------------- */ -/* Those flags must not conflict with other TCL_ENCODING_* flags in tcl.h */ -#define TCL_ENCODING_LE 0x40 /* Little-endian encoding */ -#define TCL_ENCODING_EXTERNAL 0x80 /* Converting from internal to external variant */ +/* This flags must not conflict with other TCL_ENCODING_* flags in tcl.h */ +#define TCL_ENCODING_MODIFIED 0x20 /* Converting NULL bytes to 0xC0 0x80 */ +/* Since TCL_ENCODING_MODIFIED is only used for utf-8 and + * TCL_ENCODING_LE is only used for utf-16/ucs-2, re-use the same value */ +#define TCL_ENCODING_LE TCL_ENCODING_MODIFIED /* Little-endian encoding */ void TclInitEncodingSubsystem(void) @@ -522,7 +524,7 @@ TclInitEncodingSubsystem(void) unsigned size; unsigned short i; union { - unsigned char c; + char c; short s; } isLe; @@ -1075,19 +1077,21 @@ Tcl_ExternalToUtfDString( } flags = TCL_ENCODING_START | TCL_ENCODING_END; + if (encodingPtr->toUtfProc == UtfToUtfProc) { + flags |= TCL_ENCODING_MODIFIED; + } while (1) { result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars); soFar = dst + dstWrote - Tcl_DStringValue(dstPtr); + src += srcRead; if (result != TCL_CONVERT_NOSPACE) { Tcl_DStringSetLength(dstPtr, soFar); return Tcl_DStringValue(dstPtr); } - flags &= ~TCL_ENCODING_START; - src += srcRead; srcLen -= srcRead; if (Tcl_DStringLength(dstPtr) == 0) { Tcl_DStringSetLength(dstPtr, dstLen); @@ -1183,15 +1187,17 @@ Tcl_ExternalToUtf( if (!noTerminate) { /* * If there are any null characters in the middle of the buffer, - * they will converted to the UTF-8 null character (\xC080). To get + * they will converted to the UTF-8 null character (\xC0\x80). To get * the actual \0 at the end of the destination buffer, we need to * append it manually. First make room for it... */ dstLen--; } + if (encodingPtr->toUtfProc == UtfToUtfProc) { + flags |= TCL_ENCODING_MODIFIED; + } do { - int savedFlags = flags; Tcl_EncodingState savedState = *statePtr; result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen, @@ -1201,7 +1207,6 @@ Tcl_ExternalToUtf( break; } dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1); - flags = savedFlags; *statePtr = savedState; } while (1); if (!noTerminate) { @@ -1266,7 +1271,7 @@ Tcl_UtfToExternalDString( flags = TCL_ENCODING_START | TCL_ENCODING_END; while (1) { result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, - srcLen, flags | TCL_ENCODING_EXTERNAL, &state, dst, dstLen, + srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars); soFar = dst + dstWrote - Tcl_DStringValue(dstPtr); @@ -1368,7 +1373,7 @@ Tcl_UtfToExternal( dstLen -= encodingPtr->nullSize; result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen, - flags | TCL_ENCODING_EXTERNAL, statePtr, dst, dstLen, srcReadPtr, + flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr); if (encodingPtr->nullSize == 2) { dst[*dstWrotePtr + 1] = '\0'; @@ -2108,7 +2113,7 @@ BinaryProc( static int UtfToUtfProc( - TCL_UNUSED(ClientData), + ClientData clientData, /* additional flags, e.g. TCL_ENCODING_MODIFIED */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -2147,6 +2152,7 @@ UtfToUtfProc( } dstStart = dst; + flags |= PTR2INT(clientData); dstEnd = dst + dstLen - TCL_UTF_MAX; for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { @@ -2163,7 +2169,7 @@ UtfToUtfProc( result = TCL_CONVERT_NOSPACE; break; } - if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && !(flags & TCL_ENCODING_EXTERNAL))) { + if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && (flags & TCL_ENCODING_MODIFIED))) { /* * Copy 7bit characters, but skip null-bytes when we are in input * mode, so that they get converted to 0xC080. @@ -2171,7 +2177,7 @@ UtfToUtfProc( *dst++ = *src++; } else if (UCHAR(*src) == 0xC0 && (src + 1 < srcEnd) - && UCHAR(src[1]) == 0x80 && (flags & TCL_ENCODING_EXTERNAL)) { + && UCHAR(src[1]) == 0x80 && !(flags & TCL_ENCODING_MODIFIED)) { /* * Convert 0xC080 to real nulls when we are in output mode. */ @@ -2186,16 +2192,23 @@ UtfToUtfProc( * unless the user has explicitly asked to be told. */ - if (flags & TCL_ENCODING_STOPONERROR) { - result = TCL_CONVERT_MULTIBYTE; - break; + if (flags & TCL_ENCODING_MODIFIED) { + if (flags & TCL_ENCODING_STOPONERROR) { + result = TCL_CONVERT_MULTIBYTE; + break; + } + ch = UCHAR(*src++); + } else { + char chbuf[2]; + chbuf[0] = UCHAR(*src++); chbuf[1] = 0; + TclUtfToUCS4(chbuf, &ch); } - ch = UCHAR(*src); - src += 1; dst += Tcl_UniCharToUtf(ch, dst); } else { + int low; size_t len = TclUtfToUCS4(src, &ch); - if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR)) { + if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR) + && (flags & TCL_ENCODING_MODIFIED)) { result = TCL_CONVERT_SYNTAX; break; } @@ -2205,7 +2218,7 @@ UtfToUtfProc( * A surrogate character is detected, handle especially. */ - int low = ch; + low = ch; len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0; if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) { @@ -2352,7 +2365,7 @@ Utf16ToUtfProc( static int UtfToUtf16Proc( - ClientData clientData, /* != NULL means LE, == NUL means BE */ + ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -2386,6 +2399,7 @@ UtfToUtf16Proc( dstStart = dst; dstEnd = dst + dstLen - sizeof(Tcl_UniChar); + flags |= PTR2INT(clientData); result = TCL_OK; for (numChars = 0; src < srcEnd; numChars++) { @@ -2403,7 +2417,7 @@ UtfToUtf16Proc( break; } src += TclUtfToUCS4(src, &ch); - if (clientData) { + if (flags & TCL_ENCODING_LE) { if (ch <= 0xFFFF) { *dst++ = (ch & 0xFF); *dst++ = (ch >> 8); diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 93d0a32..16b45d7 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -52,6 +52,8 @@ static int ReflectGetOption(ClientData clientData, static int ReflectSetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, const char *newValue); +static int ReflectTruncate(ClientData clientData, + long long length); static void TimerRunRead(ClientData clientData); static void TimerRunWrite(ClientData clientData); @@ -80,7 +82,7 @@ static const Tcl_ChannelType tclRChannelType = { #else NULL, /* thread action */ #endif - NULL /* truncate */ + ReflectTruncate /* Truncate. NULL'able */ }; /* @@ -178,6 +180,7 @@ static const char *const methodNames[] = { "initialize", /* */ "read", /* OPT */ "seek", /* OPT */ + "truncate", /* OPT */ "watch", /* */ "write", /* OPT */ NULL @@ -191,6 +194,7 @@ typedef enum { METH_INIT, METH_READ, METH_SEEK, + METH_TRUNCATE, METH_WATCH, METH_WRITE } MethodName; @@ -200,7 +204,8 @@ typedef enum { (FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH)) #define NULLABLE_METHODS \ (FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \ - FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL)) + FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \ + FLAG(METH_CGETALL) | FLAG(METH_TRUNCATE)) #define RANDW \ (TCL_READABLE | TCL_WRITABLE) @@ -230,7 +235,8 @@ typedef enum { ForwardedBlock, ForwardedSetOpt, ForwardedGetOpt, - ForwardedGetOptAll + ForwardedGetOptAll, + ForwardedTruncate } ForwardedOperation; /* @@ -293,6 +299,10 @@ struct ForwardParamGetOpt { const char *name; /* Name of option to get, maybe NULL */ Tcl_DString *value; /* Result */ }; +struct ForwardParamTruncate { + ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ + Tcl_WideInt length; /* I: Length of file. */ +}; /* * Now join all these together in a single union for convenience. @@ -307,6 +317,7 @@ typedef union ForwardParam { struct ForwardParamBlock block; struct ForwardParamSetOpt setOpt; struct ForwardParamGetOpt getOpt; + struct ForwardParamTruncate truncate; } ForwardParam; /* @@ -695,6 +706,9 @@ TclChanCreateObjCmd( if (!(methods & FLAG(METH_SEEK))) { clonePtr->wideSeekProc = NULL; } + if (!(methods & FLAG(METH_TRUNCATE))) { + clonePtr->truncateProc = NULL; + } chanPtr->typePtr = clonePtr; } @@ -2020,6 +2034,73 @@ ReflectGetOption( } /* + *---------------------------------------------------------------------- + * + * ReflectTruncate -- + * + * This function is invoked to truncate a channel's file size. + * + * Results: + * A standard Tcl result code. + * + * Side effects: + * Arbitrary, as it calls upon a Tcl script. + * + *---------------------------------------------------------------------- + */ + +static int +ReflectTruncate( + ClientData clientData, /* Channel to query */ + long long length) /* Length to truncate to. */ +{ + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; + Tcl_Obj *lenObj; + int errorNum; /* EINVAL or EOK (success). */ + Tcl_Obj *resObj; /* Result for 'truncate' */ + + /* + * Are we in the correct thread? + */ + +#ifdef TCL_THREADS + if (rcPtr->thread != Tcl_GetCurrentThread()) { + ForwardParam p; + + p.truncate.length = length; + + ForwardOpToHandlerThread(rcPtr, ForwardedTruncate, &p); + + if (p.base.code != TCL_OK) { + PassReceivedError(rcPtr->chan, &p); + return EINVAL; + } + + return EOK; + } +#endif + + /* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */ + + Tcl_Preserve(rcPtr); + + lenObj = Tcl_NewIntObj(length); + Tcl_IncrRefCount(lenObj); + + if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) { + Tcl_SetChannelError(rcPtr->chan, resObj); + errorNum = EINVAL; + } else { + errorNum = EOK; + } + + Tcl_DecrRefCount(lenObj); + Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + Tcl_Release(rcPtr); + return errorNum; +} + +/* * Helpers. ========================================================= */ @@ -3253,6 +3334,19 @@ ForwardProc( Tcl_Release(rcPtr); break; + case ForwardedTruncate: { + Tcl_Obj *lenObj = Tcl_NewIntObj(paramPtr->truncate.length); + + Tcl_IncrRefCount(lenObj); + Tcl_Preserve(rcPtr); + if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) { + ForwardSetObjError(paramPtr, resObj); + } + Tcl_Release(rcPtr); + Tcl_DecrRefCount(lenObj); + break; + } + default: /* * Bad operation code. diff --git a/generic/tclInt.h b/generic/tclInt.h index 4bf077b..d551910 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2672,7 +2672,6 @@ MODULE_SCOPE char *tclNativeExecutableName; MODULE_SCOPE int tclFindExecutableSearchDone; MODULE_SCOPE char *tclMemDumpFileName; MODULE_SCOPE TclPlatformType tclPlatform; -MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks; MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; @@ -2889,6 +2888,7 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, const char *name, Tcl_Namespace *nameNamespacePtr, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); +MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPt); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, @@ -3064,12 +3064,21 @@ MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); -MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); +MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, + Tcl_Obj* pathPtr); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, size_t len); +MODULE_SCOPE void TclpAlertNotifier(ClientData clientData); +MODULE_SCOPE void TclpServiceModeHook(int mode); +MODULE_SCOPE void TclpSetTimer(const Tcl_Time *timePtr); +MODULE_SCOPE int TclpWaitForEvent(const Tcl_Time *timePtr); +MODULE_SCOPE void TclpCreateFileHandler(int fd, int mask, + Tcl_FileProc *proc, ClientData clientData); MODULE_SCOPE int TclpDeleteFile(const void *path); +MODULE_SCOPE void TclpDeleteFileHandler(int fd); MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); +MODULE_SCOPE void TclpFinalizeNotifier(ClientData clientData); MODULE_SCOPE void TclpFinalizePipes(void); MODULE_SCOPE void TclpFinalizeSockets(void); MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, @@ -3083,6 +3092,7 @@ MODULE_SCOPE size_t TclpFindVariable(const char *name, size_t *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, size_t *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); +MODULE_SCOPE ClientData TclpInitNotifier(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); @@ -3109,8 +3119,9 @@ MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr); MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); -MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName); -MODULE_SCOPE void *TclInitPkgFiles(Tcl_Interp *interp); +MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, + const char *fileName); +MODULE_SCOPE void * TclInitPkgFiles(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_PathPart portion); MODULE_SCOPE char * TclpReadlink(const char *fileName, @@ -4151,6 +4162,37 @@ MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); #define TCL_INDEX_START ((size_t)0) /* + *---------------------------------------------------------------------- + * + * TclScaleTime -- + * + * TIP #233 (Virtualized Time): Wrapper around the time virutalisation + * rescale function to hide the binding of the clientData. + * + * This is static inline code; it's like a macro, but a function. It's + * used because this is a piece of code that ends up in places that are a + * bit performance sensitive. + * + * Results: + * None + * + * Side effects: + * Updates the time structure (given as an argument) with what the time + * should be after virtualisation. + * + *---------------------------------------------------------------------- + */ + +static inline void +TclScaleTime( + Tcl_Time *timePtr) +{ + if (timePtr != NULL) { + tclScaleTimeProcPtr(timePtr, tclTimeClientData); + } +} + +/* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. * TclNewObj(objPtr) creates a new object denoting an empty string. @@ -5083,11 +5125,33 @@ typedef struct NRE_callback { #endif /* + * Special hack for macOS, where the static linker (technically the 'ar' + * command) hates empty object files, and accepts no flags to make it shut up. + * + * These symbols are otherwise completely useless. + * + * They can't be written to or written through. They can't be seen by any + * other code. They use a separate attribute (supported by all macOS + * compilers, which are derivatives of clang or gcc) to stop the compilation + * from moaning. They will be excluded during the final linking stage. + * + * Other platforms get nothing at all. That's good. + */ + +#ifdef MAC_OSX_TCL +#define TCL_MAC_EMPTY_FILE(name) \ + static __attribute__((used)) const void *const TclUnusedFile_ ## name; \ + static const void *const TclUnusedFile_ ## name = NULL; +#else +#define TCL_MAC_EMPTY_FILE(name) +#endif /* MAC_OSX_TCL */ + +/* * Other externals. */ -MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment - * (if changed with tcl-env). */ +MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment + * (if changed with tcl-env). */ #endif /* _TCLINT */ diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index b2d717b..607072b 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -917,10 +917,10 @@ Tcl_DeleteNamespace( /* * Give anyone interested - notably TclOO - a chance to use this namespace * normally despite the fact that the namespace is going to go. Allows the - * calling of destructors. Will only be called once (unless re-established + * calling of destructors. Only called once (unless re-established * by the called function). [Bug 2950259] * - * Note that setting this field requires access to the internal definition + * Setting this field requires access to the internal definition * of namespaces, so it should only be accessed by code that knows about * being careful with reentrancy. */ @@ -1065,7 +1065,7 @@ Tcl_DeleteNamespace( } TclNsDecrRefCount(nsPtr); } - + int TclNamespaceDeleted( Namespace *nsPtr) @@ -1073,6 +1073,83 @@ TclNamespaceDeleted( return (nsPtr->flags & NS_DYING) ? 1 : 0; } +void +TclDeleteNamespaceChildren( + Namespace *nsPtr /* Namespace whose children to delete */ +) +{ + Interp *iPtr = (Interp *) nsPtr->interp; + Tcl_HashEntry *entryPtr; + int i, unchecked; + Tcl_HashSearch search; + /* + * Delete all the child namespaces. + * + * BE CAREFUL: When each child is deleted, it divorces itself from its + * parent. The hash table can't be proplery traversed if its elements are + * being deleted. Because of traces (and the desire to avoid the + * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug + * f97d4ee020]) copy to a temporary array and then delete all those + * namespaces. + * + * Important: leave the hash table itself still live. + */ + +#ifndef BREAK_NAMESPACE_COMPAT + unchecked = (nsPtr->childTable.numEntries > 0); + while (nsPtr->childTable.numEntries > 0 && unchecked) { + int length = nsPtr->childTable.numEntries; + Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, + sizeof(Namespace *) * length); + + i = 0; + for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); + entryPtr != NULL; + entryPtr = Tcl_NextHashEntry(&search)) { + children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); + children[i]->refCount++; + i++; + } + unchecked = 0; + for (i = 0 ; i < length ; i++) { + if (!(children[i]->flags & NS_DYING)) { + unchecked = 1; + Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); + TclNsDecrRefCount(children[i]); + } + } + TclStackFree((Tcl_Interp *) iPtr, children); + } +#else + if (nsPtr->childTablePtr != NULL) { + unchecked = (nsPtr->childTable.numEntries > 0); + while (nsPtr->childTable.numEntries > 0 && unchecked) { + int length = nsPtr->childTablePtr->numEntries; + Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, + sizeof(Namespace *) * length); + + i = 0; + for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); + entryPtr != NULL; + entryPtr = Tcl_NextHashEntry(&search)) { + children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); + children[i]->refCount++; + i++; + } + unchecked = 0; + for (i = 0 ; i < length ; i++) { + if (!(children[i]->flags & NS_DYING)) { + unchecked = 1; + Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); + TclNsDecrRefCount(children[i]); + } + } + TclStackFree((Tcl_Interp *) iPtr, children); + } + } +#endif +} + /* *---------------------------------------------------------------------- * @@ -1105,6 +1182,9 @@ TclTeardownNamespace( Tcl_HashSearch search; size_t i; + + TclDeleteNamespaceChildren(nsPtr); + /* * Start by destroying the namespace's variable table, since variables * might trigger traces. Variable table should be cleared but not freed! @@ -1181,62 +1261,6 @@ TclTeardownNamespace( nsPtr->commandPathSourceList = NULL; } - /* - * Delete all the child namespaces. - * - * BE CAREFUL: When each child is deleted, it will divorce itself from its - * parent. You can't traverse a hash table properly if its elements are - * being deleted. Because of traces (and the desire to avoid the - * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug - * f97d4ee020]) we copy to a temporary array and then delete all those - * namespaces. - * - * Important: leave the hash table itself still live. - */ - -#ifndef BREAK_NAMESPACE_COMPAT - while (nsPtr->childTable.numEntries > 0) { - size_t length = nsPtr->childTable.numEntries; - Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Namespace *) * length); - - i = 0; - for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); - entryPtr != NULL; - entryPtr = Tcl_NextHashEntry(&search)) { - children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); - children[i]->refCount++; - i++; - } - for (i = 0 ; i < length ; i++) { - Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); - TclNsDecrRefCount(children[i]); - } - TclStackFree((Tcl_Interp *) iPtr, children); - } -#else - if (nsPtr->childTablePtr != NULL) { - while (nsPtr->childTablePtr->numEntries > 0) { - size_t length = nsPtr->childTablePtr->numEntries; - Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Namespace *) * length); - - i = 0; - for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); - entryPtr != NULL; - entryPtr = Tcl_NextHashEntry(&search)) { - children[i] = Tcl_GetHashValue(entryPtr); - children[i]->refCount++; - i++; - } - for (i = 0 ; i < length ; i++) { - Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); - TclNsDecrRefCount(children[i]); - } - TclStackFree((Tcl_Interp *) iPtr, children); - } - } -#endif /* * Free the namespace's export pattern array. diff --git a/generic/tclNotify.c b/generic/tclNotify.c index 897346e..862b957 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -10,6 +10,7 @@ * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 1998 Scriptics Corporation. * Copyright © 2003 Kevin B. Kenny. All rights reserved. + * Copyright © 2021 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -18,11 +19,11 @@ #include "tclInt.h" /* - * Module-scope struct of notifier hooks that are checked in the default + * Notifier hooks that are checked in the public wrappers for the default * notifier functions (for overriding via Tcl_SetNotifier). */ -Tcl_NotifierProcs tclNotifierHooks = { +static Tcl_NotifierProcs tclNotifierHooks = { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL }; @@ -174,7 +175,8 @@ TclFinalizeNotifier(void) Tcl_Event *evPtr, *hold; if (!tsdPtr->initialized) { - return; /* Notifier not initialized for the current thread */ + return; /* Notifier not initialized for the current + * thread. */ } Tcl_MutexLock(&(tsdPtr->queueMutex)); @@ -227,6 +229,38 @@ Tcl_SetNotifier( Tcl_NotifierProcs *notifierProcPtr) { tclNotifierHooks = *notifierProcPtr; + + /* + * Don't allow hooks to refer to the hook point functions; avoids infinite + * loop. + */ + + if (tclNotifierHooks.setTimerProc == Tcl_SetTimer) { + tclNotifierHooks.setTimerProc = NULL; + } + if (tclNotifierHooks.waitForEventProc == Tcl_WaitForEvent) { + tclNotifierHooks.waitForEventProc = NULL; + } + if (tclNotifierHooks.initNotifierProc == Tcl_InitNotifier) { + tclNotifierHooks.initNotifierProc = NULL; + } + if (tclNotifierHooks.finalizeNotifierProc == Tcl_FinalizeNotifier) { + tclNotifierHooks.finalizeNotifierProc = NULL; + } + if (tclNotifierHooks.alertNotifierProc == Tcl_AlertNotifier) { + tclNotifierHooks.alertNotifierProc = NULL; + } + if (tclNotifierHooks.serviceModeHookProc == Tcl_ServiceModeHook) { + tclNotifierHooks.serviceModeHookProc = NULL; + } +#ifndef _WIN32 + if (tclNotifierHooks.createFileHandlerProc == Tcl_CreateFileHandler) { + tclNotifierHooks.createFileHandlerProc = NULL; + } + if (tclNotifierHooks.deleteFileHandlerProc == Tcl_DeleteFileHandler) { + tclNotifierHooks.deleteFileHandlerProc = NULL; + } +#endif /* !_WIN32 */ } /* @@ -276,7 +310,7 @@ Tcl_CreateEventSource( * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - EventSource *sourcePtr = (EventSource *)Tcl_Alloc(sizeof(EventSource)); + EventSource *sourcePtr = (EventSource *) Tcl_Alloc(sizeof(EventSource)); sourcePtr->setupProc = setupProc; sourcePtr->checkProc = checkProc; @@ -794,7 +828,7 @@ Tcl_SetServiceMode( void Tcl_SetMaxBlockTime( - const Tcl_Time *timePtr) /* Specifies a maximum elapsed time for the + const Tcl_Time *timePtr) /* Specifies a maximum elapsed time for the * next blocking operation in the event * tsdPtr-> */ { @@ -1133,6 +1167,260 @@ Tcl_ThreadAlert( } /* + *---------------------------------------------------------------------- + * + * Tcl_InitNotifier -- + * + * Initializes the platform specific notifier state. Forwards to the + * platform implementation when the hook is not enabled. + * + * Results: + * Returns a handle to the notifier state for this thread.. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +ClientData +Tcl_InitNotifier(void) +{ + if (tclNotifierHooks.initNotifierProc) { + return tclNotifierHooks.initNotifierProc(); + } else { + return TclpInitNotifier(); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_FinalizeNotifier -- + * + * This function is called to cleanup the notifier state before a thread + * is terminated. Forwards to the platform implementation when the hook + * is not enabled. + * + * Results: + * None. + * + * Side effects: + * If no finalizeNotifierProc notifier hook exists, TclpFinalizeNotifier + * is called. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_FinalizeNotifier( + ClientData clientData) +{ + if (tclNotifierHooks.finalizeNotifierProc) { + tclNotifierHooks.finalizeNotifierProc(clientData); + } else { + TclpFinalizeNotifier(clientData); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AlertNotifier -- + * + * Wake up the specified notifier from any thread. This routine is called + * by the platform independent notifier code whenever the Tcl_ThreadAlert + * routine is called. This routine is guaranteed not to be called by Tcl + * on a given notifier after Tcl_FinalizeNotifier is called for that + * notifier. This routine is typically called from a thread other than + * the notifier's thread. Forwards to the platform implementation when + * the hook is not enabled. + * + * Results: + * None. + * + * Side effects: + * See the platform-specific implementations. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AlertNotifier( + ClientData clientData) /* Pointer to thread data. */ +{ + if (tclNotifierHooks.alertNotifierProc) { + tclNotifierHooks.alertNotifierProc(clientData); + } else { + TclpAlertNotifier(clientData); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_ServiceModeHook -- + * + * This function is invoked whenever the service mode changes. Forwards + * to the platform implementation when the hook is not enabled. + * + * Results: + * None. + * + * Side effects: + * See the platform-specific implementations. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_ServiceModeHook( + int mode) /* Either TCL_SERVICE_ALL, or + * TCL_SERVICE_NONE. */ +{ + if (tclNotifierHooks.serviceModeHookProc) { + tclNotifierHooks.serviceModeHookProc(mode); + } else { + TclpServiceModeHook(mode); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetTimer -- + * + * This function sets the current notifier timer value. Forwards to the + * platform implementation when the hook is not enabled. + * + * Results: + * None. + * + * Side effects: + * See the platform-specific implementations. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetTimer( + const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ +{ + if (tclNotifierHooks.setTimerProc) { + tclNotifierHooks.setTimerProc(timePtr); + } else { + TclpSetTimer(timePtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_WaitForEvent -- + * + * This function is called by Tcl_DoOneEvent to wait for new events on + * the notifier's message queue. If the block time is 0, then + * Tcl_WaitForEvent just polls without blocking. Forwards to the + * platform implementation when the hook is not enabled. + * + * Results: + * Returns -1 if the wait would block forever, 1 if an out-of-loop source + * was processed (see platform-specific notes) and otherwise returns 0. + * + * Side effects: + * Queues file events that are detected by the notifier. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_WaitForEvent( + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ +{ + if (tclNotifierHooks.waitForEventProc) { + return tclNotifierHooks.waitForEventProc(timePtr); + } else { + return TclpWaitForEvent(timePtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_CreateFileHandler -- + * + * This function registers a file descriptor handler with the notifier. + * Forwards to the platform implementation when the hook is not enabled. + * + * This function is not defined on Windows. The OS API there is too + * different. + * + * Results: + * None. + * + * Side effects: + * Creates a new file handler structure. + * + *---------------------------------------------------------------------- + */ + +#ifndef _WIN32 +void +Tcl_CreateFileHandler( + int fd, /* Handle of stream to watch. */ + int mask, /* OR'ed combination of TCL_READABLE, + * TCL_WRITABLE, and TCL_EXCEPTION: indicates + * conditions under which proc should be + * called. */ + Tcl_FileProc *proc, /* Function to call for each selected + * event. */ + ClientData clientData) /* Arbitrary data to pass to proc. */ +{ + if (tclNotifierHooks.createFileHandlerProc) { + tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); + } else { + TclpCreateFileHandler(fd, mask, proc, clientData); + } +} +#endif /* !_WIN32 */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_DeleteFileHandler -- + * + * Cancel a previously-arranged callback arrangement for a file + * descriptor. Forwards to the platform implementation when the hook is + * not enabled. + * + * This function is not defined on Windows. The OS API there is too + * different. + * + * Results: + * None. + * + * Side effects: + * If a callback was previously registered on the file descriptor, remove + * it. + * + *---------------------------------------------------------------------- + */ + +#ifndef _WIN32 +void +Tcl_DeleteFileHandler( + int fd) /* Stream id for which to remove callback + * function. */ +{ + if (tclNotifierHooks.deleteFileHandlerProc) { + tclNotifierHooks.deleteFileHandlerProc(fd); + } else { + TclpDeleteFileHandler(fd); + } +} +#endif /* !_WIN32 */ + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclOO.c b/generic/tclOO.c index 4dbe668..559cf0b 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1184,18 +1184,19 @@ ObjectNamespaceDeleted( * freed memory. */ - if (((Command *) oPtr->command)->flags && CMD_DYING) { - /* - * Something has already started the command deletion process. We can - * go ahead and clean up the the namespace, - */ - } else { - /* - * The namespace must have been deleted directly. Delete the command - * as well. - */ + if (oPtr->command != NULL) { + if (((Command *) oPtr->command)->flags && CMD_DYING) { + /* + * The command is already (being) deleted. Proceed to clean up the the namespace, + */ + } else { + /* + * The namespace must have been deleted directly. Delete the command + * as well. + */ - Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); + Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); + } } if (oPtr->myclassCommand) { diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c index e50a6b9..1446301 100644 --- a/generic/tclThreadJoin.c +++ b/generic/tclThreadJoin.c @@ -305,6 +305,8 @@ TclSignalExitThread( Tcl_MutexUnlock(&threadPtr->threadMutex); } +#else +TCL_MAC_EMPTY_FILE(generic_tclThreadJoin_c) #endif /* _WIN32 */ /* diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 4a0b73c..be13164 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -534,7 +534,58 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; /* *---------------------------------------------------------------------- * - * Tcl_InitNotifier -- + * LookUpFileHandler -- + * + * Look up the file handler structure (and optionally the previous one in + * the chain) associated with a file descriptor. + * + * Returns: + * A pointer to the file handler, or NULL if it can't be found. + * + * Side effects: + * If prevPtrPtr is non-NULL, it will be written to if the file handler + * is found. + * + *---------------------------------------------------------------------- + */ + +static inline FileHandler * +LookUpFileHandler( + ThreadSpecificData *tsdPtr, /* Where to look things up. */ + int fd, /* What we are looking for. */ + FileHandler **prevPtrPtr) /* If non-NULL, where to report the previous + * pointer. */ +{ + FileHandler *filePtr, *prevPtr; + + /* + * Find the entry for the given file (and return if there isn't one). + */ + + for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; + prevPtr = filePtr, filePtr = filePtr->nextPtr) { + if (filePtr == NULL) { + return NULL; + } + if (filePtr->fd == fd) { + break; + } + } + + /* + * Report what we've found to our caller. + */ + + if (prevPtrPtr) { + *prevPtrPtr = prevPtr; + } + return filePtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclpInitNotifier -- * * Initializes the platform specific notifier state. * @@ -548,22 +599,16 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; */ ClientData -Tcl_InitNotifier(void) +TclpInitNotifier(void) { - ThreadSpecificData *tsdPtr; - - if (tclNotifierHooks.initNotifierProc) { - return tclNotifierHooks.initNotifierProc(); - } - - tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #ifdef WEAK_IMPORT_SPINLOCKLOCK /* * Initialize support for weakly imported spinlock API. */ if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) { - Tcl_Panic("Tcl_InitNotifier: pthread_once failed"); + Tcl_Panic("Tcl_InitNotifier: %s", "pthread_once failed"); } #endif @@ -590,7 +635,8 @@ Tcl_InitNotifier(void) runLoopSource = CFRunLoopSourceCreate(NULL, LONG_MIN, &runLoopSourceContext); if (!runLoopSource) { - Tcl_Panic("Tcl_InitNotifier: could not create CFRunLoopSource"); + Tcl_Panic("Tcl_InitNotifier: %s", + "could not create CFRunLoopSource"); } CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes); CFRunLoopAddSource(runLoop, runLoopSource, tclEventsOnlyRunLoopMode); @@ -602,8 +648,8 @@ Tcl_InitNotifier(void) LONG_MIN, UpdateWaitingListAndServiceEvents, &runLoopObserverContext); if (!runLoopObserver) { - Tcl_Panic("Tcl_InitNotifier: could not create " - "CFRunLoopObserver"); + Tcl_Panic("Tcl_InitNotifier: %s", + "could not create CFRunLoopObserver"); } CFRunLoopAddObserver(runLoop, runLoopObserver, kCFRunLoopCommonModes); @@ -620,8 +666,8 @@ Tcl_InitNotifier(void) LONG_MIN, UpdateWaitingListAndServiceEvents, &runLoopObserverContext); if (!runLoopObserverTcl) { - Tcl_Panic("Tcl_InitNotifier: could not create " - "CFRunLoopObserver"); + Tcl_Panic("Tcl_InitNotifier: %s", + "could not create CFRunLoopObserver"); } CFRunLoopAddObserver(runLoop, runLoopObserverTcl, tclEventsOnlyRunLoopMode); @@ -650,7 +696,7 @@ Tcl_InitNotifier(void) int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild); if (result) { - Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed"); + Tcl_Panic("Tcl_InitNotifier: %s", "pthread_atfork failed"); } atForkInit = 1; } @@ -663,20 +709,20 @@ Tcl_InitNotifier(void) */ if (pipe(fds) != 0) { - Tcl_Panic("Tcl_InitNotifier: could not create trigger pipe"); + Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe"); } status = fcntl(fds[0], F_GETFL); status |= O_NONBLOCK; if (fcntl(fds[0], F_SETFL, status) < 0) { - Tcl_Panic("Tcl_InitNotifier: could not make receive pipe non " - "blocking"); + Tcl_Panic("Tcl_InitNotifier: %s", + "could not make receive pipe non-blocking"); } status = fcntl(fds[1], F_GETFL); status |= O_NONBLOCK; if (fcntl(fds[1], F_SETFL, status) < 0) { - Tcl_Panic("Tcl_InitNotifier: could not make trigger pipe non " - "blocking"); + Tcl_Panic("Tcl_InitNotifier: %s", + "could not make trigger pipe non-blocking"); } receivePipe = fds[0]; @@ -762,7 +808,7 @@ StartNotifierThread(void) pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); pthread_attr_setstacksize(&attr, 60 * 1024); result = pthread_create(¬ifierThread, &attr, - (void * (*)(void *))NotifierThreadProc, NULL); + (void * (*)(void *)) NotifierThreadProc, NULL); pthread_attr_destroy(&attr); if (result) { Tcl_Panic("StartNotifierThread: unable to start notifier thread"); @@ -776,7 +822,7 @@ StartNotifierThread(void) /* *---------------------------------------------------------------------- * - * Tcl_FinalizeNotifier -- + * TclpFinalizeNotifier -- * * This function is called to cleanup the notifier state before a thread * is terminated. @@ -792,17 +838,10 @@ StartNotifierThread(void) */ void -Tcl_FinalizeNotifier( - ClientData clientData) +TclpFinalizeNotifier( + TCL_UNUSED(ClientData)) { - ThreadSpecificData *tsdPtr; - - if (tclNotifierHooks.finalizeNotifierProc) { - tclNotifierHooks.finalizeNotifierProc(clientData); - return; - } - - tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); LOCK_NOTIFIER_INIT; notifierCount--; @@ -876,7 +915,7 @@ Tcl_FinalizeNotifier( /* *---------------------------------------------------------------------- * - * Tcl_AlertNotifier -- + * TclpAlertNotifier -- * * Wake up the specified notifier from any thread. This routine is called * by the platform independent notifier code whenever the Tcl_ThreadAlert @@ -893,15 +932,10 @@ Tcl_FinalizeNotifier( */ void -Tcl_AlertNotifier( +TclpAlertNotifier( ClientData clientData) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; - - if (tclNotifierHooks.alertNotifierProc) { - tclNotifierHooks.alertNotifierProc(clientData); - return; - } + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; LOCK_NOTIFIER_TSD; if (tsdPtr->runLoop) { @@ -914,7 +948,7 @@ Tcl_AlertNotifier( /* *---------------------------------------------------------------------- * - * Tcl_SetTimer -- + * TclpSetTimer -- * * This function sets the current notifier timer value. * @@ -928,18 +962,13 @@ Tcl_AlertNotifier( */ void -Tcl_SetTimer( +TclpSetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { ThreadSpecificData *tsdPtr; CFRunLoopTimerRef runLoopTimer; CFTimeInterval waitTime; - if (tclNotifierHooks.setTimerProc) { - tclNotifierHooks.setTimerProc(timePtr); - return; - } - tsdPtr = TCL_TSD_INIT(&dataKey); runLoopTimer = tsdPtr->runLoopTimer; if (!runLoopTimer) { @@ -949,7 +978,7 @@ Tcl_SetTimer( Tcl_Time vTime = *timePtr; if (vTime.sec != 0 || vTime.usec != 0) { - tclScaleTimeProcPtr(&vTime, tclTimeClientData); + TclScaleTime(&vTime); waitTime = vTime.sec + 1.0e-6 * vTime.usec; } else { waitTime = 0; @@ -988,7 +1017,7 @@ TimerWakeUp( /* *---------------------------------------------------------------------- * - * Tcl_ServiceModeHook -- + * TclpServiceModeHook -- * * This function is invoked whenever the service mode changes. * @@ -1002,18 +1031,11 @@ TimerWakeUp( */ void -Tcl_ServiceModeHook( +TclpServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { - ThreadSpecificData *tsdPtr; - - if (tclNotifierHooks.serviceModeHookProc) { - tclNotifierHooks.serviceModeHookProc(mode); - return; - } - - tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (mode == TCL_SERVICE_ALL && !tsdPtr->runLoopTimer) { if (!tsdPtr->runLoop) { @@ -1033,9 +1055,9 @@ Tcl_ServiceModeHook( /* *---------------------------------------------------------------------- * - * Tcl_CreateFileHandler -- + * TclpCreateFileHandler -- * - * This function registers a file handler with the select notifier. + * This function registers a file handler with the notifier. * * Results: * None. @@ -1047,7 +1069,7 @@ Tcl_ServiceModeHook( */ void -Tcl_CreateFileHandler( +TclpCreateFileHandler( int fd, /* Handle of stream to watch. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates @@ -1057,24 +1079,11 @@ Tcl_CreateFileHandler( * event. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { - ThreadSpecificData *tsdPtr; - FileHandler *filePtr; - - if (tclNotifierHooks.createFileHandlerProc) { - tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); - return; - } - - tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); - for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { - if (filePtr->fd == fd) { - break; - } - } if (filePtr == NULL) { - filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -1113,7 +1122,7 @@ Tcl_CreateFileHandler( /* *---------------------------------------------------------------------- * - * Tcl_DeleteFileHandler -- + * TclpDeleteFileHandler -- * * Cancel a previously-arranged callback arrangement for a file. * @@ -1127,47 +1136,34 @@ Tcl_CreateFileHandler( */ void -Tcl_DeleteFileHandler( +TclpDeleteFileHandler( int fd) /* Stream id for which to remove callback * function. */ { FileHandler *filePtr, *prevPtr; - int i, numFdBits; - ThreadSpecificData *tsdPtr; - - if (tclNotifierHooks.deleteFileHandlerProc) { - tclNotifierHooks.deleteFileHandlerProc(fd); - return; - } - - tsdPtr = TCL_TSD_INIT(&dataKey); - numFdBits = -1; + int i, numFdBits = -1; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Find the entry for the given file (and return if there isn't one). */ - for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; - prevPtr = filePtr, filePtr = filePtr->nextPtr) { - if (filePtr == NULL) { - return; - } - if (filePtr->fd == fd) { - break; - } + filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr); + if (filePtr == NULL) { + return; } /* * Find current max fd. */ - if (fd+1 == tsdPtr->numFdBits) { + if (fd + 1 == tsdPtr->numFdBits) { numFdBits = 0; - for (i = fd-1; i >= 0; i--) { + for (i = fd - 1; i >= 0; i--) { if (FD_ISSET(i, &tsdPtr->checkMasks.readable) || FD_ISSET(i, &tsdPtr->checkMasks.writable) || FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) { - numFdBits = i+1; + numFdBits = i + 1; break; } } @@ -1250,12 +1246,8 @@ FileHandlerEventProc( */ tsdPtr = TCL_TSD_INIT(&dataKey); - for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { - if (filePtr->fd != fileEvPtr->fd) { - continue; - } - + filePtr = LookUpFileHandler(tsdPtr, fileEvPtr->fd, NULL); + if (filePtr != NULL) { /* * The code is tricky for two reasons: * 1. The file handler's desired events could have changed since the @@ -1284,7 +1276,6 @@ FileHandlerEventProc( UNLOCK_NOTIFIER_TSD; filePtr->proc(filePtr->clientData, mask); } - break; } return 1; } @@ -1292,7 +1283,7 @@ FileHandlerEventProc( /* *---------------------------------------------------------------------- * - * Tcl_WaitForEvent -- + * TclpWaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on * the message queue. If the block time is 0, then Tcl_WaitForEvent just @@ -1309,7 +1300,7 @@ FileHandlerEventProc( */ int -Tcl_WaitForEvent( +TclpWaitForEvent( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { int result, polling, runLoopRunning; @@ -1317,9 +1308,6 @@ Tcl_WaitForEvent( SInt32 runLoopStatus; ThreadSpecificData *tsdPtr; - if (tclNotifierHooks.waitForEventProc) { - return tclNotifierHooks.waitForEventProc(timePtr); - } result = -1; polling = 0; waitTime = CF_TIMEINTERVAL_FOREVER; @@ -1343,10 +1331,9 @@ Tcl_WaitForEvent( */ if (vTime.sec != 0 || vTime.usec != 0) { - tclScaleTimeProcPtr(&vTime, tclTimeClientData); + TclScaleTime(&vTime); waitTime = vTime.sec + 1.0e-6 * vTime.usec; } else { - /* * The max block time was set to 0. * @@ -1357,8 +1344,8 @@ Tcl_WaitForEvent( * or timers are ready to fire immediately, only one (possibly two * if one is a version 0 source) will be fired, regardless of the * value of returnAfterSourceHandled." This can cause some chanio - * tests to fail. So we use a small positive waitTime unless there - * is another RunLoop running. + * tests to fail. So we use a small positive waitTime unless + * there is another RunLoop running. */ polling = 1; @@ -1431,7 +1418,7 @@ QueueFileEvents( { SelectMasks readyMasks; FileHandler *filePtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) info; /* * Queue all detected file events. @@ -1470,7 +1457,8 @@ QueueFileEvents( */ if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)Tcl_Alloc(sizeof(FileHandlerEvent)); + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -1485,8 +1473,8 @@ QueueFileEvents( * * UpdateWaitingListAndServiceEvents -- * - * CFRunLoopObserver callback for updating waitingList and - * servicing Tcl events. + * CFRunLoopObserver callback for updating waitingList and servicing Tcl + * events. * * Results: * None. @@ -1503,7 +1491,8 @@ UpdateWaitingListAndServiceEvents( CFRunLoopActivity activity, void *info) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) info; + if (tsdPtr->sleeping) { return; } @@ -1626,8 +1615,7 @@ Tcl_Sleep( vdelay.sec = ms / 1000; vdelay.usec = (ms % 1000) * 1000; - tclScaleTimeProcPtr(&vdelay, tclTimeClientData); - + TclScaleTime(&vdelay); if (tsdPtr->runLoop) { CFTimeInterval waitTime; @@ -1853,7 +1841,7 @@ TclUnixWaitForFile( * * Result: * None. Once started, this routine never exits. It dies with the overall - * process. + * process or terminates its own thread (on notifier termination). * * Side effects: * The trigger pipe used to signal the notifier thread is created when @@ -2090,9 +2078,9 @@ AtForkChild(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * If a child process unlocks an os_unfair_lock that was created in its parent - * the child will exit with an illegal instruction error. So we reinitialize - * the lock in the child rather than attempt to unlock it. + * If a child process unlocks an os_unfair_lock that was created in its + * parent the child will exit with an illegal instruction error. So we + * reinitialize the lock in the child rather than attempt to unlock it. */ #if defined(USE_OS_UNFAIR_LOCK) diff --git a/tests/binary.test b/tests/binary.test index 68ff428..a910390 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -25,9 +25,9 @@ proc testIEEE {} { switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian - binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \ ieeeValues(-Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) @@ -37,19 +37,19 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \ ieeeValues(+Normal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \ ieeeValues(+Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { - binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) - binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) @@ -59,11 +59,11 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) - binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) - binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) - binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 @@ -160,16 +160,16 @@ test binary-4.3 {Tcl_BinaryObjCmd: format} { } \x80 test binary-4.4 {Tcl_BinaryObjCmd: format} { binary format B* 010011 -} \x4c +} \x4C test binary-4.5 {Tcl_BinaryObjCmd: format} { binary format B8 01001101 -} \x4d +} \x4D test binary-4.6 {Tcl_BinaryObjCmd: format} { binary format A2X2B9 oo 01001101 -} \x4d\x00 +} \x4D\x00 test binary-4.7 {Tcl_BinaryObjCmd: format} { binary format B9 010011011010 -} \x4d\x80 +} \x4D\x80 test binary-4.8 {Tcl_BinaryObjCmd: format} { binary format B2B3 10 010 } \x80\x40 @@ -191,16 +191,16 @@ test binary-5.4 {Tcl_BinaryObjCmd: format} { } 2 test binary-5.5 {Tcl_BinaryObjCmd: format} { binary format b8 01001101 -} \xb2 +} \xB2 test binary-5.6 {Tcl_BinaryObjCmd: format} { binary format A2X2b9 oo 01001101 -} \xb2\x00 +} \xB2\x00 test binary-5.7 {Tcl_BinaryObjCmd: format} { binary format b9 010011011010 -} \xb2\x01 +} \xB2\x01 test binary-5.8 {Tcl_BinaryObjCmd: format} { binary format b17 1 -} \x01\00\00 +} \x01\x00\x00 test binary-5.9 {Tcl_BinaryObjCmd: format} { binary format b2b3 10 010 } \x01\x02 @@ -219,19 +219,19 @@ test binary-6.3 {Tcl_BinaryObjCmd: format} { } \x01 test binary-6.4 {Tcl_BinaryObjCmd: format} { binary format h c -} \x0c +} \x0C test binary-6.5 {Tcl_BinaryObjCmd: format} { binary format h* baadf00d -} \xab\xda\x0f\xd0 +} \xAB\xDA\x0F\xD0 test binary-6.6 {Tcl_BinaryObjCmd: format} { binary format h4 c410 -} \x4c\x01 +} \x4C\x01 test binary-6.7 {Tcl_BinaryObjCmd: format} { binary format h6 c4102 -} \x4c\x01\x02 +} \x4C\x01\x02 test binary-6.8 {Tcl_BinaryObjCmd: format} { binary format h5 c41020304 -} \x4c\x01\x02 +} \x4C\x01\x02 test binary-6.9 {Tcl_BinaryObjCmd: format} { binary format a3X3h5 foo 2 } \x02\x00\x00 @@ -253,19 +253,19 @@ test binary-7.3 {Tcl_BinaryObjCmd: format} { } \x10 test binary-7.4 {Tcl_BinaryObjCmd: format} { binary format H c -} \xc0 +} \xC0 test binary-7.5 {Tcl_BinaryObjCmd: format} { binary format H* baadf00d -} \xba\xad\xf0\x0d +} \xBA\xAD\xF0\x0D test binary-7.6 {Tcl_BinaryObjCmd: format} { binary format H4 c410 -} \xc4\x10 +} \xC4\x10 test binary-7.7 {Tcl_BinaryObjCmd: format} { binary format H6 c4102 -} \xc4\x10\x20 +} \xC4\x10\x20 test binary-7.8 {Tcl_BinaryObjCmd: format} { binary format H5 c41023304 -} \xc4\x10\x20 +} \xC4\x10\x20 test binary-7.9 {Tcl_BinaryObjCmd: format} { binary format a3X3H5 foo 2 } \x20\x00\x00 @@ -485,34 +485,34 @@ test binary-13.3 {Tcl_BinaryObjCmd: format} { } {} test binary-13.4 {Tcl_BinaryObjCmd: format} bigEndian { binary format f 1.6 -} \x3f\xcc\xcc\xcd +} \x3F\xCC\xCC\xCD test binary-13.5 {Tcl_BinaryObjCmd: format} littleEndian { binary format f 1.6 -} \xcd\xcc\xcc\x3f +} \xCD\xCC\xCC\x3F test binary-13.6 {Tcl_BinaryObjCmd: format} bigEndian { binary format f* {1.6 3.4} -} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a +} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A test binary-13.7 {Tcl_BinaryObjCmd: format} littleEndian { binary format f* {1.6 3.4} -} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 +} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 test binary-13.8 {Tcl_BinaryObjCmd: format} bigEndian { binary format f2 {1.6 3.4} -} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a +} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A test binary-13.9 {Tcl_BinaryObjCmd: format} littleEndian { binary format f2 {1.6 3.4} -} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 +} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 test binary-13.10 {Tcl_BinaryObjCmd: format} bigEndian { binary format f2 {1.6 3.4 5.6} -} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a +} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian { binary format f2 {1.6 3.4 5.6} -} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 +} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian { binary format f -3.402825e+38 -} \xff\x7f\xff\xff +} \xFF\x7F\xFF\xFF test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian { binary format f -3.402825e+38 -} \xff\xff\x7f\xff +} \xFF\xFF\x7F\xFF test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian { binary format f -3.402825e-100 } \x80\x00\x00\x00 @@ -529,11 +529,11 @@ test binary-13.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body { test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian { set a {1.6 3.4} binary format f1 $a -} \x3f\xcc\xcc\xcd +} \x3F\xCC\xCC\xCD test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian { set a {1.6 3.4} binary format f1 $a -} \xcd\xcc\xcc\x3f +} \xCD\xCC\xCC\x3F test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format d @@ -546,28 +546,28 @@ test binary-14.3 {Tcl_BinaryObjCmd: format} { } {} test binary-14.4 {Tcl_BinaryObjCmd: format} bigEndian { binary format d 1.6 -} \x3f\xf9\x99\x99\x99\x99\x99\x9a +} \x3F\xF9\x99\x99\x99\x99\x99\x9A test binary-14.5 {Tcl_BinaryObjCmd: format} littleEndian { binary format d 1.6 -} \x9a\x99\x99\x99\x99\x99\xf9\x3f +} \x9A\x99\x99\x99\x99\x99\xF9\x3F test binary-14.6 {Tcl_BinaryObjCmd: format} bigEndian { binary format d* {1.6 3.4} -} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 +} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 test binary-14.7 {Tcl_BinaryObjCmd: format} littleEndian { binary format d* {1.6 3.4} -} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 +} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 test binary-14.8 {Tcl_BinaryObjCmd: format} bigEndian { binary format d2 {1.6 3.4} -} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 +} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 test binary-14.9 {Tcl_BinaryObjCmd: format} littleEndian { binary format d2 {1.6 3.4} -} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 +} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian { binary format d2 {1.6 3.4 5.6} -} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 +} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian { binary format d2 {1.6 3.4 5.6} -} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 +} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 test binary-14.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format d2 {1.6} } -result {number of elements in list does not match count} @@ -578,11 +578,11 @@ test binary-14.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body { test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian { set a {1.6 3.4} binary format d1 $a -} \x3f\xf9\x99\x99\x99\x99\x99\x9a +} \x3F\xF9\x99\x99\x99\x99\x99\x9A test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian { set a {1.6 3.4} binary format d1 $a -} \x9a\x99\x99\x99\x99\x99\xf9\x3f +} \x9A\x99\x99\x99\x99\x99\xF9\x3F test binary-14.18 {FormatNumber: Bug 1116542} { binary scan [binary format d 1.25] d w set w @@ -874,11 +874,11 @@ test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-24.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 h* arg1] $arg1 + list [binary scan \x52\xA3 h* arg1] $arg1 } {1 253a} test binary-24.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \xc2\xa3 h arg1] $arg1 + list [binary scan \xC2\xA3 h arg1] $arg1 } {1 2} test binary-24.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -890,7 +890,7 @@ test binary-24.5 {Tcl_BinaryObjCmd: scan} { } {1 {}} test binary-24.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \xf2\x53 h2 arg1] $arg1 + list [binary scan \xF2\x53 h2 arg1] $arg1 } {1 2f} test binary-24.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -920,11 +920,11 @@ test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-25.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 H* arg1] $arg1 + list [binary scan \x52\xA3 H* arg1] $arg1 } {1 52a3} test binary-25.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \xc2\xa3 H arg1] $arg1 + list [binary scan \xC2\xA3 H arg1] $arg1 } {1 c} test binary-25.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -936,7 +936,7 @@ test binary-25.5 {Tcl_BinaryObjCmd: scan} { } {1 {}} test binary-25.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \xf2\x53 H2 arg1] $arg1 + list [binary scan \xF2\x53 H2 arg1] $arg1 } {1 f2} test binary-25.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -965,27 +965,27 @@ test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-26.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 c* arg1] $arg1 + list [binary scan \x52\xA3 c* arg1] $arg1 } {1 {82 -93}} test binary-26.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 c arg1] $arg1 + list [binary scan \x52\xA3 c arg1] $arg1 } {1 82} test binary-26.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 c1 arg1] $arg1 + list [binary scan \x52\xA3 c1 arg1] $arg1 } {1 82} test binary-26.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 c0 arg1] $arg1 + list [binary scan \x52\xA3 c0 arg1] $arg1 } {1 {}} test binary-26.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 c2 arg1] $arg1 + list [binary scan \x52\xA3 c2 arg1] $arg1 } {1 {82 -93}} test binary-26.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \xff c arg1] $arg1 + list [binary scan \xFF c arg1] $arg1 } {1 -1} test binary-26.8 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -1006,15 +1006,15 @@ test binary-26.10 {Tcl_BinaryObjCmd: scan} { } {2 {112 -121} 5} test binary-26.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 cu* arg1] $arg1 + list [binary scan \x52\xA3 cu* arg1] $arg1 } {1 {82 163}} test binary-26.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 cu arg1] $arg1 + list [binary scan \x52\xA3 cu arg1] $arg1 } {1 82} test binary-26.13 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \xff cu arg1] $arg1 + list [binary scan \xFF cu arg1] $arg1 } {1 255} test binary-26.14 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 @@ -1034,23 +1034,23 @@ test binary-27.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-27.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 s* arg1] $arg1 } {1 {-23726 21587}} test binary-27.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 s arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 s arg1] $arg1 } {1 -23726} test binary-27.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 s1 arg1] $arg1 + list [binary scan \x52\xA3 s1 arg1] $arg1 } {1 -23726} test binary-27.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 s0 arg1] $arg1 + list [binary scan \x52\xA3 s0 arg1] $arg1 } {1 {}} test binary-27.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 s2 arg1] $arg1 } {1 {-23726 21587}} test binary-27.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -1067,23 +1067,23 @@ test binary-27.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x52\xA3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2 } {2 {-23726 21587} 5} test binary-27.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 su* arg1] $arg1 } {1 {41810 21587}} test binary-27.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2 + list [binary scan \xFF\xFF\xFF\xFF sus arg1 arg2] $arg1 $arg2 } {2 65535 -1} test binary-27.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2 + list [binary scan \xFF\xFF\xFF\xFF ssu arg1 arg2] $arg1 $arg2 } {2 -1 65535} test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { @@ -1091,23 +1091,23 @@ test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-28.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 S* arg1] $arg1 } {1 {21155 21332}} test binary-28.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 S arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 S arg1] $arg1 } {1 21155} test binary-28.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 S1 arg1] $arg1 + list [binary scan \x52\xA3 S1 arg1] $arg1 } {1 21155} test binary-28.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3 S0 arg1] $arg1 + list [binary scan \x52\xA3 S0 arg1] $arg1 } {1 {}} test binary-28.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 S2 arg1] $arg1 } {1 {21155 21332}} test binary-28.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -1124,15 +1124,15 @@ test binary-28.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x52\xA3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2 } {2 {21155 21332} 5} test binary-28.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 Su* arg1] $arg1 } {1 {21155 21332}} test binary-28.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1 + list [binary scan \xA3\x52\x54\x53 Su* arg1] $arg1 } {1 {41810 21587}} test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { @@ -1140,23 +1140,23 @@ test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-29.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1 } {1 {1414767442 67305985}} test binary-29.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 i arg1] $arg1 } {1 1414767442} test binary-29.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 i1 arg1] $arg1 } {1 1414767442} test binary-29.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53 i0 arg1] $arg1 + list [binary scan \x52\xA3\x53 i0 arg1] $arg1 } {1 {}} test binary-29.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1 } {1 {1414767442 67305985}} test binary-29.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -1173,15 +1173,15 @@ test binary-29.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2 } {2 {1414767442 67305985} 5} test binary-29.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 - list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2 + list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF iui arg1 arg2] $arg1 $arg2 } {2 4294967295 -1} test binary-29.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 - list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2 + list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF iiu arg1 arg2] $arg1 $arg2 } {2 -1 4294967295} test binary-29.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 @@ -1193,23 +1193,23 @@ test binary-30.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-30.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1 } {1 {1386435412 16909060}} test binary-30.3 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 I arg1] $arg1 } {1 1386435412} test binary-30.4 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 I1 arg1] $arg1 } {1 1386435412} test binary-30.5 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53 I0 arg1] $arg1 + list [binary scan \x52\xA3\x53 I0 arg1] $arg1 } {1 {}} test binary-30.6 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1 } {1 {1386435412 16909060}} test binary-30.7 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -1226,15 +1226,15 @@ test binary-30.9 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2 } {2 {1386435412 16909060} 5} test binary-30.10 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 - list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2 + list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF IuI arg1 arg2] $arg1 $arg2 } {2 4294967295 -1} test binary-30.11 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 - list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2 + list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF IIu arg1 arg2] $arg1 $arg2 } {2 -1 4294967295} test binary-30.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 arg2 @@ -1246,43 +1246,43 @@ test binary-31.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A f* arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 f* arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A f arg1] $arg1 } {1 1.600000023841858} test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 f arg1] $arg1 } {1 1.600000023841858} test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD f1 arg1] $arg1 } {1 1.600000023841858} test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F f1 arg1] $arg1 } {1 1.600000023841858} test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD f0 arg1] $arg1 } {1 {}} test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F f0 arg1] $arg1 } {1 {}} test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A f2 arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 f2 arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-31.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -1293,19 +1293,19 @@ test binary-31.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 - binary scan \x3f\xcc\xcc\xcd f1 arg1(a) + binary scan \x3F\xCC\xCC\xCD f1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A\x05 f2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2 + list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} test binary-32.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { @@ -1313,43 +1313,43 @@ test binary-32.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 d* arg1] $arg1 } {1 {1.6 3.4}} test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 d* arg1] $arg1 } {1 {1.6 3.4}} test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 d arg1] $arg1 } {1 1.6} test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 d arg1] $arg1 } {1 1.6} test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A d1 arg1] $arg1 } {1 1.6} test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F d1 arg1] $arg1 } {1 1.6} test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A d0 arg1] $arg1 } {1 {}} test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F d0 arg1] $arg1 } {1 {}} test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1 } {1 {1.6 3.4}} test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 d2 arg1] $arg1 } {1 {1.6 3.4}} test binary-32.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -1360,19 +1360,19 @@ test binary-32.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 - binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a) + binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A d1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2 } {2 {1.6 3.4} 5} test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40\x05 d2c* arg1 arg2] $arg1 $arg2 } {2 {1.6 3.4} 5} test binary-33.1 {Tcl_BinaryObjCmd: scan} { @@ -1543,20 +1543,20 @@ test binary-38.4 {FormatNumber: word alignment} { } \x01\x00\x00\x00\x01 test binary-38.5 {FormatNumber: word alignment} bigEndian { set x [binary format c1d1 1 1.6] -} \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a +} \x01\x3F\xF9\x99\x99\x99\x99\x99\x9A test binary-38.6 {FormatNumber: word alignment} littleEndian { set x [binary format c1d1 1 1.6] -} \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f +} \x01\x9A\x99\x99\x99\x99\x99\xF9\x3F test binary-38.7 {FormatNumber: word alignment} bigEndian { set x [binary format c1f1 1 1.6] -} \x01\x3f\xcc\xcc\xcd +} \x01\x3F\xCC\xCC\xCD test binary-38.8 {FormatNumber: word alignment} littleEndian { set x [binary format c1f1 1 1.6] -} \x01\xcd\xcc\xcc\x3f +} \x01\xCD\xCC\xCC\x3F test binary-39.1 {ScanNumber: sign extension} { unset -nocomplain arg1 - list [binary scan \x52\xa3 c2 arg1] $arg1 + list [binary scan \x52\xA3 c2 arg1] $arg1 } {1 {82 -93}} test binary-39.2 {ScanNumber: sign extension} { unset -nocomplain arg1 @@ -1576,7 +1576,7 @@ test binary-39.5 {ScanNumber: sign extension} { } {1 {16843010 -2130640639 25297153 16876033 16843137}} test binary-39.6 {ScanNumber: no sign extension} { unset -nocomplain arg1 - list [binary scan \x52\xa3 cu2 arg1] $arg1 + list [binary scan \x52\xA3 cu2 arg1] $arg1 } {1 {82 163}} test binary-39.7 {ScanNumber: no sign extension} { unset -nocomplain arg1 @@ -1597,11 +1597,11 @@ test binary-39.10 {ScanNumber: no sign extension} { test binary-40.3 {ScanNumber: NaN} -body { unset -nocomplain arg1 - list [binary scan \xff\xff\xff\xff f1 arg1] $arg1 + list [binary scan \xFF\xFF\xFF\xFF f1 arg1] $arg1 } -match glob -result {1 -NaN*} test binary-40.4 {ScanNumber: NaN} -body { unset -nocomplain arg1 - list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1 + list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF d arg1] $arg1 } -match glob -result {1 -NaN*} test binary-41.1 {ScanNumber: word alignment} -setup { @@ -1627,22 +1627,22 @@ test binary-41.4 {ScanNumber: word alignment} -setup { test binary-41.5 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -constraints bigEndian -body { - list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2 + list [binary scan \x01\x3F\xCC\xCC\xCD c1f1 arg1 arg2] $arg1 $arg2 } -result {2 1 1.600000023841858} test binary-41.6 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -constraints littleEndian -body { - list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2 + list [binary scan \x01\xCD\xCC\xCC\x3F c1f1 arg1 arg2] $arg1 $arg2 } -result {2 1 1.600000023841858} test binary-41.7 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -constraints bigEndian -body { - list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2 + list [binary scan \x01\x3F\xF9\x99\x99\x99\x99\x99\x9A c1d1 arg1 arg2] $arg1 $arg2 } -result {2 1 1.6} test binary-41.8 {ScanNumber: word alignment} -setup { unset -nocomplain arg1 arg2 } -constraints littleEndian -body { - list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 + list [binary scan \x01\x9A\x99\x99\x99\x99\x99\xF9\x3F c1d1 arg1 arg2] $arg1 $arg2 } -result {2 1 1.6} test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body { @@ -1713,26 +1713,26 @@ test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} { } {66 64 0 0 0 0 127 -1 -1 -1 65 76} test binary-46.1 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { - binary format a* \u20ac -} \u00ac + binary format a* € +} \xAC test binary-46.2 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { - list [binary scan [binary format a* \u20ac\u20bd] s x] $x + list [binary scan [binary format a* €₽] s x] $x } {1 -16980} test binary-46.3 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { set x {} set y {} set z {} - list [binary scan [binary format a* \u20ac\u20bd] aaa x y z] $x $y $z -} "2 \u00ac \u00bd {}" + list [binary scan [binary format a* €₽] aaa x y z] $x $y $z +} "2 \xAC \xBD {}" test binary-46.4 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { - set x [encoding convertto iso8859-15 \u20ac] + set x [encoding convertto iso8859-15 €] set y [binary format a* $x] list $x $y -} "\u00a4 \u00a4" +} "\xA4 \xA4" test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { - set x [binary scan \u00a4 a* y] + set x [binary scan \xA4 a* y] list $x $y [encoding convertfrom iso8859-15 $y] -} "1 \u00a4 \u20ac" +} "1 \xA4 €" test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} { # This test is only reliable when memory debugging is turned on, but @@ -1898,28 +1898,28 @@ test binary-51.3 {Tcl_BinaryObjCmd: format} { } {} test binary-51.4 {Tcl_BinaryObjCmd: format} {} { binary format Q 1.6 -} \x3f\xf9\x99\x99\x99\x99\x99\x9a +} \x3F\xF9\x99\x99\x99\x99\x99\x9A test binary-51.5 {Tcl_BinaryObjCmd: format} {} { binary format q 1.6 -} \x9a\x99\x99\x99\x99\x99\xf9\x3f +} \x9A\x99\x99\x99\x99\x99\xF9\x3F test binary-51.6 {Tcl_BinaryObjCmd: format} {} { binary format Q* {1.6 3.4} -} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 +} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 test binary-51.7 {Tcl_BinaryObjCmd: format} {} { binary format q* {1.6 3.4} -} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 +} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 test binary-51.8 {Tcl_BinaryObjCmd: format} {} { binary format Q2 {1.6 3.4} -} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 +} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 test binary-51.9 {Tcl_BinaryObjCmd: format} {} { binary format q2 {1.6 3.4} -} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 +} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 test binary-51.10 {Tcl_BinaryObjCmd: format} {} { binary format Q2 {1.6 3.4 5.6} -} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 +} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 test binary-51.11 {Tcl_BinaryObjCmd: format} {} { binary format q2 {1.6 3.4 5.6} -} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 +} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 test binary-51.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format q2 {1.6} } -result {number of elements in list does not match count} @@ -1930,11 +1930,11 @@ test binary-51.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body { test binary-51.16 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format Q1 $a -} \x3f\xf9\x99\x99\x99\x99\x99\x9a +} \x3F\xF9\x99\x99\x99\x99\x99\x9A test binary-51.17 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format q1 $a -} \x9a\x99\x99\x99\x99\x99\xf9\x3f +} \x9A\x99\x99\x99\x99\x99\xF9\x3F # format R/r test binary-53.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { @@ -1948,34 +1948,34 @@ test binary-53.3 {Tcl_BinaryObjCmd: format} { } {} test binary-53.4 {Tcl_BinaryObjCmd: format} {} { binary format R 1.6 -} \x3f\xcc\xcc\xcd +} \x3F\xCC\xCC\xCD test binary-53.5 {Tcl_BinaryObjCmd: format} {} { binary format r 1.6 -} \xcd\xcc\xcc\x3f +} \xCD\xCC\xCC\x3F test binary-53.6 {Tcl_BinaryObjCmd: format} {} { binary format R* {1.6 3.4} -} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a +} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A test binary-53.7 {Tcl_BinaryObjCmd: format} {} { binary format r* {1.6 3.4} -} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 +} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 test binary-53.8 {Tcl_BinaryObjCmd: format} {} { binary format R2 {1.6 3.4} -} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a +} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A test binary-53.9 {Tcl_BinaryObjCmd: format} {} { binary format r2 {1.6 3.4} -} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 +} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 test binary-53.10 {Tcl_BinaryObjCmd: format} {} { binary format R2 {1.6 3.4 5.6} -} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a +} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A test binary-53.11 {Tcl_BinaryObjCmd: format} {} { binary format r2 {1.6 3.4 5.6} -} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 +} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} { binary format R -3.402825e+38 -} \xff\x7f\xff\xff +} \xFF\x7F\xFF\xFF test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} { binary format r -3.402825e+38 -} \xff\xff\x7f\xff +} \xFF\xFF\x7F\xFF test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} { binary format R -3.402825e-100 } \x80\x00\x00\x00 @@ -1992,11 +1992,11 @@ test binary-53.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body { test binary-53.18 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format R1 $a -} \x3f\xcc\xcc\xcd +} \x3F\xCC\xCC\xCD test binary-53.19 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format r1 $a -} \xcd\xcc\xcc\x3f +} \xCD\xCC\xCC\x3F # scan t (s) test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { @@ -2004,23 +2004,23 @@ test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 t* arg1] $arg1 } {1 {-23726 21587}} test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 t arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 t arg1] $arg1 } {1 -23726} test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3 t1 arg1] $arg1 + list [binary scan \x52\xA3 t1 arg1] $arg1 } {1 -23726} test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3 t0 arg1] $arg1 + list [binary scan \x52\xA3 t0 arg1] $arg1 } {1 {}} test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 t2 arg1] $arg1 } {1 {-23726 21587}} test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 @@ -2037,7 +2037,7 @@ test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x52\xA3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2 } {2 {-23726 21587} 5} test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 @@ -2058,23 +2058,23 @@ test binary-55.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 t* arg1] $arg1 } {1 {21155 21332}} test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 t arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 t arg1] $arg1 } {1 21155} test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3 t1 arg1] $arg1 + list [binary scan \x52\xA3 t1 arg1] $arg1 } {1 21155} test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3 t0 arg1] $arg1 + list [binary scan \x52\xA3 t0 arg1] $arg1 } {1 {}} test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 t2 arg1] $arg1 } {1 {21155 21332}} test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 @@ -2091,7 +2091,7 @@ test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x52\xA3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2 } {2 {21155 21332} 5} test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 @@ -2112,23 +2112,23 @@ test binary-56.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1 } {1 {1414767442 67305985}} test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n arg1] $arg1 } {1 1414767442} test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 n1 arg1] $arg1 } {1 1414767442} test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53 n0 arg1] $arg1 + list [binary scan \x52\xA3\x53 n0 arg1] $arg1 } {1 {}} test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1 } {1 {1414767442 67305985}} test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 @@ -2145,7 +2145,7 @@ test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 } {2 {1414767442 67305985} 5} test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 @@ -2166,23 +2166,23 @@ test binary-57.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1 } {1 {1386435412 16909060}} test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n arg1] $arg1 } {1 1386435412} test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54 n1 arg1] $arg1 } {1 1386435412} test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53 n0 arg1] $arg1 + list [binary scan \x52\xA3\x53 n0 arg1] $arg1 } {1 {}} test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1 } {1 {1386435412 16909060}} test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 @@ -2199,7 +2199,7 @@ test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 } {2 {1386435412 16909060} 5} test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 @@ -2220,43 +2220,43 @@ test binary-58.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1 } {1 {1.6 3.4}} test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 q* arg1] $arg1 } {1 {1.6 3.4}} test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 Q arg1] $arg1 } {1 1.6} test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 q arg1] $arg1 } {1 1.6} test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A Q1 arg1] $arg1 } {1 1.6} test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F q1 arg1] $arg1 } {1 1.6} test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A Q0 arg1] $arg1 } {1 {}} test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F q0 arg1] $arg1 } {1 {}} test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1 } {1 {1.6 3.4}} test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 q2 arg1] $arg1 } {1 {1.6 3.4}} test binary-58.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -2267,19 +2267,19 @@ test binary-58.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 - binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a) + binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A q1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2 } {2 {1.6 3.4} 5} test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40\x05 q2c* arg1 arg2] $arg1 $arg2 } {2 {1.6 3.4} 5} # scan R/r @@ -2288,43 +2288,43 @@ test binary-59.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { } -result {not enough arguments for all format specifiers} test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A R* arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 r* arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A R arg1] $arg1 } {1 1.600000023841858} test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 r arg1] $arg1 } {1 1.600000023841858} test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD R1 arg1] $arg1 } {1 1.600000023841858} test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F r1 arg1] $arg1 } {1 1.600000023841858} test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD R0 arg1] $arg1 } {1 {}} test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F r0 arg1] $arg1 } {1 {}} test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 - list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1 + list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A R2 arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 - list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1 + list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 r2 arg1] $arg1 } {1 {1.600000023841858 3.4000000953674316}} test binary-59.12 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 @@ -2335,19 +2335,19 @@ test binary-59.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -returnCodes error -body { set arg1 1 - binary scan \x3f\xcc\xcc\xcd r1 arg1(a) + binary scan \x3F\xCC\xCC\xCD r1 arg1(a) } -result {can't set "arg1(a)": variable isn't array} test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2 + list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A\x05 R2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian { unset -nocomplain arg1 arg2 set arg1 foo set arg2 bar - list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2 + list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2 } {2 {1.600000023841858 3.4000000953674316} 5} test binary-60.1 {[binary format] with NaN} -body { @@ -2496,7 +2496,7 @@ test binary-70.4 {binary encode hex} -body { binary encode hex [string repeat a 20] } -result [string repeat 61 20] test binary-70.5 {binary encode hex} -body { - binary encode hex \0\1\2\3\4\0\1\2\3\4 + binary encode hex \x00\x01\x02\x03\x04\x00\x01\x02\x03\x04 } -result {00010203040001020304} test binary-71.1 {binary decode hex} -body { @@ -2513,7 +2513,7 @@ test binary-71.4 {binary decode hex} -body { } -result [string repeat a 20] test binary-71.5 {binary decode hex} -body { binary decode hex 00010203040001020304 -} -result "\0\1\2\3\4\0\1\2\3\4" +} -result "\x00\x01\x02\x03\x04\x00\x01\x02\x03\x04" test binary-71.6 {binary decode hex} -body { binary decode hex "61 61" } -result {aa} @@ -2572,19 +2572,19 @@ test binary-72.4 {binary encode base64} -body { binary encode base64 [string repeat abc 20] } -result [string repeat YWJj 20] test binary-72.5 {binary encode base64} -body { - binary encode base64 \0\1\2\3\4\0\1\2\3 + binary encode base64 \x00\x01\x02\x03\x04\x00\x01\x02\x03 } -result {AAECAwQAAQID} test binary-72.6 {binary encode base64} -body { - binary encode base64 \0 + binary encode base64 \x00 } -result {AA==} test binary-72.7 {binary encode base64} -body { - binary encode base64 \0\0 + binary encode base64 \x00\x00 } -result {AAA=} test binary-72.8 {binary encode base64} -body { - binary encode base64 \0\0\0 + binary encode base64 \x00\x00\x00 } -result {AAAA} test binary-72.9 {binary encode base64} -body { - binary encode base64 \0\0\0\0 + binary encode base64 \x00\x00\x00\x00 } -result {AAAAAA==} test binary-72.10 {binary encode base64} -body { binary encode base64 -maxlen 0 -wrapchar : abcabcabc @@ -2644,7 +2644,7 @@ test binary-72.28 {binary encode base64} -body { binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc } -result {YWJjYW0123456789JjYWJj} test binary-72.29 {binary encode base64} { - string length [binary encode base64 -maxlen 3 -wrapchar \xca abc] + string length [binary encode base64 -maxlen 3 -wrapchar \xCA abc] } 5 test binary-73.1 {binary decode base64} -body { @@ -2661,19 +2661,19 @@ test binary-73.4 {binary decode base64} -body { } -result [string repeat abc 20] test binary-73.5 {binary decode base64} -body { binary decode base64 AAECAwQAAQID -} -result "\0\1\2\3\4\0\1\2\3" +} -result "\x00\x01\x02\x03\x04\x00\x01\x02\x03" test binary-73.6 {binary decode base64} -body { binary decode base64 AA== -} -result "\0" +} -result "\x00" test binary-73.7 {binary decode base64} -body { binary decode base64 AAA= -} -result "\0\0" +} -result "\x00\x00" test binary-73.8 {binary decode base64} -body { binary decode base64 AAAA -} -result "\0\0\0" +} -result "\x00\x00\x00" test binary-73.9 {binary decode base64} -body { binary decode base64 AAAAAA== -} -result "\0\0\0\0" +} -result "\x00\x00\x00\x00" test binary-73.10 {binary decode base64} -body { set s "[string repeat YWJj 10]\n[string repeat YWJj 10]" binary decode base64 $s @@ -2791,22 +2791,22 @@ test binary-74.4 {binary encode uuencode} -body { binary encode uuencode [string repeat abc 20] } -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n" test binary-74.5 {binary encode uuencode} -body { - binary encode uuencode \0\1\2\3\4\0\1\2\3 + binary encode uuencode \x00\x01\x02\x03\x04\x00\x01\x02\x03 } -result ")``\$\"`P0``0(#\n" test binary-74.6 {binary encode uuencode} -body { binary encode uuencode \0 } -result {!`` } test binary-74.7 {binary encode uuencode} -body { - binary encode uuencode \0\0 + binary encode uuencode \x00\x00 } -result "\"``` " test binary-74.8 {binary encode uuencode} -body { - binary encode uuencode \0\0\0 + binary encode uuencode \x00\x00\x00 } -result {#```` } test binary-74.9 {binary encode uuencode} -body { - binary encode uuencode \0\0\0\0 + binary encode uuencode \x00\x00\x00\x00 } -result {$`````` } test binary-74.10 {binary encode uuencode} -returnCodes error -body { @@ -2842,7 +2842,7 @@ test binary-75.4 {binary decode uuencode} -body { } -result [string repeat abc 20] test binary-75.5 {binary decode uuencode} -body { binary decode uuencode ")``\$\"`P0``0(#" -} -result "\0\1\2\3\4\0\1\2\3" +} -result "\x00\x01\x02\x03\x04\x00\x01\x02\x03" test binary-75.6 {binary decode uuencode} -body { string length [binary decode uuencode "`\n"] } -result 0 @@ -2948,7 +2948,7 @@ test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat A B C] 1 } A test binary-79.2 {Tcl_SetByteArrayLength} -body { - testsetbytearraylength [string cat \u0141 B C] 1 + testsetbytearraylength [string cat Ł B C] 1 } -constraints testsetbytearraylength -returnCodes error -match glob -result * test binary-79.3 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat A B \u0141] 0 @@ -2964,14 +2964,14 @@ test binary-79.6 {Tcl_SetByteArrayLength} -body { } -constraints testsetbytearraylength -returnCodes error -match glob -result * test binary-80.1 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { - testbytestring "\u4E4E" -} -result "expected byte sequence but character 0 was '\u4E4E' (U+004E4E)" + testbytestring "乎" +} -result "expected byte sequence but character 0 was '乎' (U+004E4E)" test binary-80.2 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\x00\xA0\xA0\xA0\xE4\xB9\x8E"] -} -result "expected byte sequence but character 4 was '\u4E4E' (U+004E4E)" +} -result "expected byte sequence but character 4 was '乎' (U+004E4E)" test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xE4\xB9\x8E"] -} -result "expected byte sequence but character 4 was '\u4E4E' (U+004E4E)" +} -result "expected byte sequence but character 4 was '乎' (U+004E4E)" test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"] } -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)" diff --git a/tests/chan.test b/tests/chan.test index 3e65433..92846d5 100644 --- a/tests/chan.test +++ b/tests/chan.test @@ -48,10 +48,10 @@ test chan-4.1 {chan command: configure subcommand} -body { chan configure } -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\"" test chan-4.2 {chan command: [Bug 800753]} -body { - chan configure stdout -eofchar \u0100 + chan configure stdout -eofchar Ā } -returnCodes error -match glob -result {bad value*} test chan-4.3 {chan command: [Bug 800753]} -body { - chan configure stdout -eofchar \u0000 + chan configure stdout -eofchar \x00 } -returnCodes error -match glob -result {bad value*} test chan-4.4 {chan command: check valid inValue, no outValue} -body { chan configure stdout -eofchar [list \x27 {}] diff --git a/tests/chanio.test b/tests/chanio.test index 04f0e3f..8dfefb7 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -79,7 +79,7 @@ namespace eval ::tcl::test::io { if {$argv != ""} { set f [open [lindex $argv 0]] } - chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a + chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A chan configure stdout -encoding binary -translation lf -buffering none chan event $f readable "foo $f" proc foo {f} { @@ -115,17 +115,17 @@ set path(test1) [makeFile {} test1] test chan-io-1.6 {Tcl_WriteChars: WriteBytes} { set f [open $path(test1) w] chan configure $f -encoding binary - chan puts -nonewline $f "a\u4e4d\0" + chan puts -nonewline $f "a乍\x00" chan close $f contents $path(test1) -} "a\x4d\x00" +} "aM\x00" test chan-io-1.7 {Tcl_WriteChars: WriteChars} { set f [open $path(test1) w] chan configure $f -encoding shiftjis - chan puts -nonewline $f "a\u4e4d\0" + chan puts -nonewline $f "a乍\x00" chan close $f contents $path(test1) -} "a\x93\xe1\x00" +} "a\x93\xE1\x00" set path(test2) [makeFile {} test2] test chan-io-1.8 {Tcl_WriteChars: WriteChars} { # This test written for SF bug #506297. @@ -138,7 +138,7 @@ test chan-io-1.8 {Tcl_WriteChars: WriteChars} { chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399] chan close $f contents $path(test2) -} " \x1b\$B\$O\x1b(B" +} " \x1B\$B\$O\x1B(B" test chan-io-1.9 {Tcl_WriteChars: WriteChars} { # When closing a channel with an encoding that appends escape bytes, check # for the case where the escape bytes overflow the current IO buffer. The @@ -273,13 +273,13 @@ test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} { # to the beginning of that UTF-8 character and try again. # # Translate the first 16 bytes, produce 14 bytes of output, 2 left over - # (first two bytes of \uff21 in UTF-8). Given those two bytes try + # (first two bytes of A in UTF-8). Given those two bytes try # translating them again, find that no bytes are read produced, and break # to outer loop where those two bytes will have the remaining 4 bytes (the - # last byte of \uff21 plus the all of \uff22) appended. + # last byte of A plus the all of B) appended. set f [open $path(test1) w] chan configure $f -encoding shiftjis -buffersize 16 - chan puts -nonewline $f "12345678901234\uff21\uff22" + chan puts -nonewline $f "12345678901234AB" set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] @@ -421,7 +421,7 @@ test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body { test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body { set f [open $path(test1) w] chan configure $f -translation binary - chan puts $f "\x81\u1234\0" + chan puts $f "\x81\u1234\x00" chan close $f set f [open $path(test1)] chan configure $f -translation binary @@ -432,14 +432,14 @@ test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body { test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body { set f [open $path(test1) w] chan configure $f -translation binary - chan puts $f "\x88\xea\x92\x9a" + chan puts $f "\x88\xEA\x92\x9A" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis list [chan gets $f line] $line } -cleanup { chan close $f -} -result [list 2 "\u4e00\u4e01"] +} -result [list 2 "一丁"] set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" append a $a append a $a @@ -467,20 +467,20 @@ test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints stdio -body { } -result {-1} test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body { set f [open $path(test1) w] - chan puts $f "abcdef\x1aghijk\nwombat" + chan puts $f "abcdef\x1Aghijk\nwombat" chan close $f set f [open $path(test1)] - chan configure $f -eofchar \x1a + chan configure $f -eofchar \x1A list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f } -result {6 abcdef -1 {}} test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body { set f [open $path(test1) w] - chan puts $f "abcdefghijk\nwom\u001abat" + chan puts $f "abcdefghijk\nwom\x1Abat" chan close $f set f [open $path(test1)] - chan configure $f -eofchar \x1a + chan configure $f -eofchar \x1A list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f @@ -865,7 +865,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup { chan configure $f -blocking 0 lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 - chan puts -nonewline $f "\nabcd\refg\x1a" + chan puts -nonewline $f "\nabcd\refg\x1A" lappend x [chan gets $f line] $line [testchannel queuedcr $f] lappend x [chan gets $f line] $line } -cleanup { @@ -883,7 +883,7 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup { chan configure $f -blocking 0 lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 - chan puts -nonewline $f "abcd\refg\x1a" + chan puts -nonewline $f "abcd\refg\x1A" lappend x [chan gets $f line] $line [testchannel queuedcr $f] lappend x [chan gets $f line] $line } -cleanup { @@ -919,7 +919,7 @@ test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eo chan configure $f -blocking 0 lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 - chan puts -nonewline $f "\n\x1a" + chan puts -nonewline $f "\n\x1A" lappend x [chan gets $f line] $line [testchannel queuedcr $f] } -cleanup { chan close $f @@ -985,10 +985,10 @@ test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -b # if (eof != NULL) set f [open $path(test1) w] chan configure $f -translation lf - chan puts -nonewline $f "123456\x1ak9012345\r" + chan puts -nonewline $f "123456\x1Ak9012345\r" chan close $f set f [open $path(test1)] - chan configure $f -eofchar \x1a + chan configure $f -eofchar \x1A list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f] } -cleanup { chan close $f @@ -1016,14 +1016,14 @@ test chan-io-6.55 {Tcl_GetsObj: overconverted} -body { # Tcl_ExternalToUtf(), make sure state updated set f [open $path(test1) w] chan configure $f -encoding iso2022-jp - chan puts $f "there\u4e00ok\n\u4e01more bytes\nhere" + chan puts $f "there一ok\n丁more bytes\nhere" chan close $f set f [open $path(test1)] chan configure $f -encoding iso2022-jp list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f -} -result [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"] +} -result [list 8 "there一ok" 11 "丁more bytes" 4 "here"] test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup { update variable x {} @@ -1057,19 +1057,19 @@ test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body { # (result == TCL_CONVERT_MULTIBYTE) set f [open $path(test1) w] chan configure $f -encoding shiftjis - chan puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend" + chan puts $f "123456789012301234\nend" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis -buffersize 16 chan gets $f } -cleanup { chan close $f -} -result "1234567890123\uff10\uff11\uff12\uff13\uff14" +} -result "123456789012301234" test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body { # (bufPtr->nextAdded < bufPtr->bufLength) set f [open $path(test1) w] chan configure $f -encoding binary - chan puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82" + chan puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis @@ -1082,7 +1082,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup { } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -encoding binary - chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" + chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis @@ -1091,13 +1091,13 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup { lappend x [chan gets $f line] $line } -cleanup { chan close $f -} -result [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""] +} -result [list 15 "123456789012301" 18 0 1 -1 ""] test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup { variable x "" } -constraints {stdio fileevent} -body { set f [openpipe w+ $path(cat)] chan configure $f -encoding binary -buffering none - chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" + chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" chan configure $f -encoding shiftjis -blocking 0 chan event $f read [namespace code { lappend x [chan gets $f line] $line [chan blocked $f] @@ -1110,7 +1110,7 @@ test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup { return $x } -cleanup { chan close $f -} -result [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0] +} -result [list -1 "" 1 17 "12345678901230123" 0] test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constraints {testchannel} -body { # (bufPtr->nextPtr == NULL) @@ -1205,7 +1205,7 @@ test chan-io-8.7 {PeekAhead: cleanup} -setup { chan puts -nonewline $f "abcdefghijklmno\r" # here lappend x [chan gets $f line] $line [testchannel queuedcr $f] - chan puts -nonewline $f "\x1a" + chan puts -nonewline $f "\x1A" lappend x [chan gets $f line] $line } -cleanup { chan close $f @@ -1361,22 +1361,22 @@ test chan-io-12.4 {ReadChars: split-up char} -setup { chan configure $f -encoding shiftjis vwait [namespace which -variable x] chan configure $f -encoding binary -blocking 1 - chan puts -nonewline $f "\x7b" + chan puts -nonewline $f "\x7B" after 500 ;# Give the cat process time to catch up chan configure $f -encoding shiftjis -blocking 0 vwait [namespace which -variable x] return $x } -cleanup { chan close $f -} -result [list "123456789012345" 1 "\u672c" 0] +} -result [list "123456789012345" 1 "本" 0] test chan-io-12.5 {ReadChars: chan events on partial characters} -setup { variable x {} } -constraints {stdio fileevent} -body { set path(test1) [makeFile { chan configure stdout -encoding binary -buffering none - chan gets stdin; chan puts -nonewline "\xe7" + chan gets stdin; chan puts -nonewline "\xE7" chan gets stdin; chan puts -nonewline "\x89" - chan gets stdin; chan puts -nonewline "\xa6" + chan gets stdin; chan puts -nonewline "\xA6" } test1] set f [openpipe r+ $path(test1)] chan event $f readable [namespace code { @@ -1401,7 +1401,7 @@ test chan-io-12.5 {ReadChars: chan events on partial characters} -setup { vwait [namespace which -variable x] vwait [namespace which -variable x] lappend x [catch {chan close $f} msg] $msg -} -result "{} timeout {} timeout \u7266 {} eof 0 {}" +} -result "{} timeout {} timeout 牦 {} eof 0 {}" test chan-io-13.1 {TranslateInputEOL: cr mode} -body { set f [open $path(test1) w] @@ -1530,7 +1530,7 @@ test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body { chan close $f } -result "abcd\ndef" test chan-io-13.11 {TranslateInputEOL: EOF char} -body { - # (*chanPtr->inEofChar != '\0') + # (*chanPtr->inEofChar != '\x00') set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\ndefgh" @@ -1542,7 +1542,7 @@ test chan-io-13.11 {TranslateInputEOL: EOF char} -body { chan close $f } -result "abcd\nd" test chan-io-13.12 {TranslateInputEOL: find EOF char in src} -body { - # (*chanPtr->inEofChar != '\0') + # (*chanPtr->inEofChar != '\x00') set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n" @@ -1878,7 +1878,7 @@ test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body list [chan configure $f -eofchar] [chan configure $f -translation] } -cleanup { chan close $f -} -result [list [list \x1a ""] {auto crlf}] +} -result [list [list \x1A ""] {auto crlf}] test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body { set f [open $path(test1) w+] list [chan configure $f -eofchar] [chan configure $f -translation] @@ -3091,10 +3091,10 @@ test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup { } -body { set f [open $path(test1) w] chan configure $f -translation lf - chan puts -nonewline $f hello\nthere\nand\rhere\n\x1a + chan puts -nonewline $f hello\nthere\nand\rhere\n\x1A chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A chan read $f } -cleanup { chan close $f @@ -3107,11 +3107,11 @@ test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup { file delete $path(test1) } -constraints {win} -body { set f [open $path(test1) w] - chan configure $f -eofchar \x1a -translation lf + chan configure $f -translation lf -eofchar \x1A chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A chan read $f } -cleanup { chan close $f @@ -3129,7 +3129,7 @@ test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $s chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A set l "" lappend l [chan gets $f] lappend l [chan gets $f] @@ -3150,7 +3150,7 @@ test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup { chan puts $f $s chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A set l "" lappend l [chan gets $f] lappend l [chan gets $f] @@ -3183,7 +3183,7 @@ test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup { lappend l [chan eof $f] } -cleanup { chan close $f -} -result "abc def 0 \x1aghi 0 qrs 0 {} 1" +} -result "abc def 0 \x1Aghi 0 qrs 0 {} 1" test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup { file delete $path(test1) set l "" @@ -3195,7 +3195,7 @@ test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup { set f [open $path(test1) r] chan configure $f -translation cr -eofchar {} set x [chan gets $f] - lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"] + lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3213,7 +3213,7 @@ test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup { set f [open $path(test1) r] chan configure $f -translation crlf -eofchar {} set x [chan gets $f] - lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"] + lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3228,7 +3228,7 @@ test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup { chan puts $f [format abc\ndef\n%cqrs\ntuv 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3242,7 +3242,7 @@ test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1a + chan configure $f -translation lf -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3256,7 +3256,7 @@ test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3270,7 +3270,7 @@ test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1a + chan configure $f -translation cr -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3284,7 +3284,7 @@ test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3298,7 +3298,7 @@ test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1a + chan configure $f -translation crlf -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3649,7 +3649,7 @@ test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup { chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] @@ -3665,11 +3665,11 @@ test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup { set l "" } -body { set f [open $path(test1) w] - chan configure $f -eofchar \x1a -translation lf + chan configure $f -translation lf -eofchar \x1A chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] @@ -3689,8 +3689,7 @@ test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a - chan configure $f -translation auto + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3708,7 +3707,7 @@ test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3738,7 +3737,7 @@ test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup { lappend l [chan eof $f] } -cleanup { chan close $f -} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1" +} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup { file delete $path(test1) set l "" @@ -3760,7 +3759,7 @@ test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup { lappend l [chan eof $f] } -cleanup { chan close $f -} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1" +} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup { file delete $path(test1) set l "" @@ -3782,7 +3781,7 @@ test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup { lappend l [chan eof $f] } -cleanup { chan close $f -} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1" +} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup { file delete $path(test1) set l "" @@ -3792,7 +3791,7 @@ test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3810,7 +3809,7 @@ test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1a + chan configure $f -translation lf -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3828,7 +3827,7 @@ test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3846,7 +3845,7 @@ test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1a + chan configure $f -translation cr -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3864,7 +3863,7 @@ test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3882,7 +3881,7 @@ test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1a + chan configure $f -translation crlf -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -4638,12 +4637,12 @@ test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar \x1a + chan configure $f -translation lf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4652,12 +4651,12 @@ test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar \x1a + chan configure $f -translation lf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1a + chan configure $f -translation lf -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4666,12 +4665,12 @@ test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation cr -eofchar \x1a + chan configure $f -translation cr -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4680,12 +4679,12 @@ test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation cr -eofchar \x1a + chan configure $f -translation cr -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1a + chan configure $f -translation cr -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4694,12 +4693,12 @@ test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation crlf -eofchar \x1a + chan configure $f -translation crlf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4708,12 +4707,12 @@ test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation crlf -eofchar \x1a + chan configure $f -translation crlf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1a + chan configure $f -translation crlf -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4727,7 +4726,7 @@ test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4741,7 +4740,7 @@ test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1a + chan configure $f -translation lf -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4755,7 +4754,7 @@ test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4769,7 +4768,7 @@ test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1a + chan configure $f -translation cr -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4783,7 +4782,7 @@ test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4797,7 +4796,7 @@ test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1a + chan configure $f -translation crlf -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -5167,27 +5166,27 @@ test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup { } -body { set f [open $path(test1) w] chan configure $f -encoding {} - chan puts -nonewline $f \xe7\x89\xa6 + chan puts -nonewline $f \xE7\x89\xA6 chan close $f set f [open $path(test1) r] chan configure $f -encoding utf-8 chan read $f } -cleanup { chan close $f -} -result \u7266 +} -result 牦 test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -encoding binary - chan puts -nonewline $f \xe7\x89\xa6 + chan puts -nonewline $f \xE7\x89\xA6 chan close $f set f [open $path(test1) r] chan configure $f -encoding utf-8 chan read $f } -cleanup { chan close $f -} -result \u7266 +} -result 牦 test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup { file delete $path(test1) set f [open $path(test1) w] @@ -5201,7 +5200,7 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_ } -constraints {stdio fileevent} -body { set f [openpipe r+ $path(cat)] chan configure $f -encoding binary - chan puts -nonewline $f "\xe7" + chan puts -nonewline $f "\xE7" chan flush $f chan configure $f -encoding utf-8 -blocking 0 chan event $f readable [namespace code { lappend x [chan read $f] }] @@ -5219,7 +5218,7 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_ return $x } -cleanup { chan close $f -} -result "{} timeout {} timeout \xe7 timeout" +} -result "{} timeout {} timeout \xE7 timeout" test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \ -constraints {socket} -body { proc accept {s a p} {chan close $s} @@ -5533,11 +5532,11 @@ test chan-io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} { } {{first script} {new script} {yet another} {}} test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} { set result {} - chan event $f r "first scr\0ipt" + chan event $f r "first scr\x00ipt" lappend result [string length [chan event $f readable]] - chan event $f r "new scr\0ipt" + chan event $f r "new scr\x00ipt" lappend result [string length [chan event $f readable]] - chan event $f r "yet ano\0ther" + chan event $f r "yet ano\x00ther" lappend result [string length [chan event $f readable]] chan event $f r "" lappend result [chan event $f readable] @@ -5983,7 +5982,7 @@ test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6007,7 +6006,7 @@ test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6031,7 +6030,7 @@ test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6055,7 +6054,7 @@ test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6079,7 +6078,7 @@ test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mo chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6103,7 +6102,7 @@ test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6127,7 +6126,7 @@ test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} - chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation lf + chan configure $f -translation lf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6151,7 +6150,7 @@ test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1a + chan configure $f -translation lf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6175,7 +6174,7 @@ test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} - chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation cr + chan configure $f -translation cr -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6199,7 +6198,7 @@ test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1a + chan configure $f -translation cr -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6223,7 +6222,7 @@ test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mod chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation crlf + chan configure $f -translation crlf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6247,7 +6246,7 @@ test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} - chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1a + chan configure $f -translation crlf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6784,7 +6783,7 @@ set path(utf8-rp.txt) [makeFile {} utf8-rp.txt] # Create kyrillic file, use lf translation to avoid os eol issues set out [open $path(kyrillic.txt) w] chan configure $out -encoding koi8-r -translation lf -chan puts $out "\u0410\u0410" +chan puts $out "АА" chan close $out test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} { # Copy kyrillic to UTF-8, using chan copy. @@ -6822,7 +6821,7 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} { test chan-io-52.11 {TclCopyChannel & encodings} -setup { set f [open $path(utf8-fcopy.txt) w] fconfigure $f -encoding utf-8 -translation lf - puts $f "\u0410\u0410" + puts $f "АА" close $f } -constraints {fcopy} -body { # binary to encoding => the input has to be in utf-8 to make sense to the @@ -7496,7 +7495,7 @@ test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} { set out [open $path(script) w] chan puts $out "catch {load $::tcltestlib Tcltest}" chan puts $out { - chan puts [testbytestring \xe2] + chan puts [testbytestring \xE2] exit 1 } proc readit {pipe} { diff --git a/tests/clock.test b/tests/clock.test index 37c8066..2a53259 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -234,7 +234,7 @@ namespace eval ::testClock { Bias 300 \ StandardBias 0 \ DaylightBias -60 \ - StandardStart \x00\x00\x0b\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \ + StandardStart \x00\x00\x0B\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \ DaylightStart \x00\x00\x03\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]] } @@ -36789,16 +36789,16 @@ test clock-58.1 {clock l10n - Japanese localisation} {*}{ -body { set trouble {} foreach {date jdate} { - 1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5 - 1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5 - 1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5 - 1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5 - 1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5 - 1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5 - 1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5 - 1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5 - 2019-04-30 \u5e73\u621031\u5e7404\u670830\u65e5 - 2019-05-01 \u4ee4\u548c01\u5e7405\u670801\u65e5 + 1872-12-31 西暦1872年12月31日 + 1873-01-01 明治06年01月01日 + 1912-07-29 明治45年07月29日 + 1912-07-30 大正01年07月30日 + 1926-12-24 大正15年12月24日 + 1926-12-25 昭和01年12月25日 + 1989-01-07 昭和64年01月07日 + 1989-01-08 平成01年01月08日 + 2019-04-30 平成31年04月30日 + 2019-05-01 令和01年05月01日 } { set status [catch { set secs [clock scan $date \ diff --git a/tests/cmdAH.test b/tests/cmdAH.test index d552d73..ba2a97c 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -143,10 +143,10 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup { test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup { set dir [pwd] } -returnCodes error -body { - cd .\0 + cd .\x00 } -cleanup { cd $dir -} -match glob -result "couldn't change working directory to \".\0\": *" +} -match glob -result "couldn't change working directory to \".\x00\": *" test cmdAH-2.7 {Tcl_ConcatObjCmd} { concat } {} @@ -180,7 +180,7 @@ test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { encoding system jis0208 - encoding convertto \u4e4e + encoding convertto 乎 } -cleanup { encoding system $system } -result 8C @@ -188,7 +188,7 @@ test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { encoding system iso8859-1 - encoding convertto jis0208 \u4e4e + encoding convertto jis0208 乎 } -cleanup { encoding system $system } -result 8C @@ -205,7 +205,7 @@ test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup { encoding convertfrom 8C } -cleanup { encoding system $system -} -result \u4e4e +} -result 乎 test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { @@ -213,7 +213,7 @@ test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup { encoding convertfrom jis0208 8C } -cleanup { encoding system $system -} -result \u4e4e +} -result 乎 test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding names foo } -result {wrong # args: should be "encoding names"} @@ -1215,7 +1215,7 @@ test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup { set oldfile $file } -constraints unix -body { # introduce some non-ascii characters. - append file \u2022 + append file • file delete -force $file file rename $oldfile $file set mtime [file mtime $file] @@ -1240,7 +1240,7 @@ test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup { set oldfile $file } -constraints win -body { # introduce some non-ascii characters. - append file \u2022 + append file • file delete -force $file file rename $oldfile $file set mtime [file mtime $file] diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 83fe80e..063750c 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -151,17 +151,17 @@ test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} { } } {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}} test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { - lsort -ascii [list \0 \x7f \x80 \uffff] -} [list \0 \x7f \x80 \uffff] + lsort -ascii [list \x00 \x7F \x80 \uFFFF] +} [list \x00 \x7F \x80 \uFFFF] test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { - lsort -ascii -nocase [list \0 \x7f \x80 \uffff] -} [list \0 \x7f \x80 \uffff] + lsort -ascii -nocase [list \x00 \x7F \x80 \uFFFF] +} [list \x00 \x7F \x80 \uFFFF] test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { - lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff] -} [list \0 \x7f \x80 \uffff \U01ffff] + lsort -ascii [list \x00 \x7F \x80 \U01ffff \uFFFF] +} [list \x00 \x7F \x80 \uFFFF \U01ffff] test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { - lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff] -} [list \0 \x7f \x80 \uffff \U01ffff] + lsort -ascii -nocase [list \x00 \x7F \x80 \U01ffff \uFFFF] +} [list \x00 \x7F \x80 \uFFFF \U01FFFF] test cmdIL-1.41 {lsort -stride and -index} -body { lsort -stride 2 -index -2 {a 2 b 1} } -returnCodes error -result {index "-2" out of range} @@ -177,7 +177,7 @@ test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup { set r 1435753299 proc rand {} { global r - set r [expr {(16807 * $r) % (0x7fffffff)}] + set r [expr {(16807 * $r) % (0x7FFFFFFF)}] } } -body { for {set i 0} {$i < 150} {incr i} { @@ -396,16 +396,16 @@ test cmdIL-4.23 {DictionaryCompare procedure, case} { } {ABcd AbCd} test cmdIL-4.24 {DictionaryCompare procedure, international characters} {hasIsoLocale} { ::tcltest::set_iso8859_1_locale - set result [lsort -dictionary "a b c A B C \xe3 \xc4"] + set result [lsort -dictionary "a b c A B C ã Ä"] ::tcltest::restore_locale set result -} "A a B b C c \xe3 \xc4" +} "A a B b C c ã Ä" test cmdIL-4.25 {DictionaryCompare procedure, international characters} {hasIsoLocale} { ::tcltest::set_iso8859_1_locale - set result [lsort -dictionary "a23\xe3 a23\xc5 a23\xe4"] + set result [lsort -dictionary "a23ã a23Å a23ä"] ::tcltest::restore_locale set result -} "a23\xe3 a23\xe4 a23\xc5" +} "a23ã a23ä a23Å" test cmdIL-4.26 {DefaultCompare procedure, signed characters} { set l [lsort [list "abc\200" "abc"]] set viewlist {} @@ -472,10 +472,10 @@ test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} { scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c } {257 32 256} test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} { - scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c + scan [lsort -ascii -nocase [list a\x00a a]] %c%c%c%c%c } {97 32 97 0 97} test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} { - scan [lsort -ascii -nocase [list a a\u0000a]] %c%c%c%c%c + scan [lsort -ascii -nocase [list a a\x00a]] %c%c%c%c%c } {97 32 97 0 97} test cmdIL-5.1 {lsort with list style index} { diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index ef9790f..a1cb6c2 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -299,19 +299,19 @@ test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} { } {]\n} test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} { apply {{} { - set x ab\000c + set x ab\x00c set y [split $x {}] binary scan $y c* z return $z }} } {97 32 98 32 0 32 99} test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} { - split "a0ab1b2bbb3\000c4" ab\000c + split "a0ab1b2bbb3\x00c4" ab\x00c } {{} 0 {} 1 2 {} {} 3 {} 4} test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} { - # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq" - split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e" -} "a b qw\u5e4eN wq" + # if not UTF-8 aware, result is "a {} {} b qwå {} N wq" + split "a乎b qw幎N wq" " 乎" +} "a b qw幎N wq" # The tests for Tcl_StringObjCmd are in string.test # The tests for Tcl_SubstObjCmd are in subst.test diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index a13421b..5f705c3 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -28,9 +28,9 @@ proc testIEEE {} { switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian - binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \ ieeeValues(-Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) @@ -40,19 +40,19 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \ ieeeValues(+Normal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \ ieeeValues(+Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { - binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) - binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) @@ -62,11 +62,11 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) - binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) - binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) - binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 diff --git a/tests/compile.test b/tests/compile.test index a50aed1..1a3601c 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -286,10 +286,10 @@ test compile-7.1 {TclCompileWhileCmd: command substituted test expression} { } {4} test compile-8.1 {CollectArgInfo: binary data} { - list [catch "string length \000foo" msg] $msg + list [catch "string length \x00foo" msg] $msg } {0 4} test compile-8.2 {CollectArgInfo: binary data} { - list [catch "string length foo\000" msg] $msg + list [catch "string length foo\x00" msg] $msg } {0 4} test compile-8.3 {CollectArgInfo: handle "]" at end of command properly} { set x ] diff --git a/tests/encoding.test b/tests/encoding.test index 0ed7d91..fab29fd 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -183,7 +183,7 @@ test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} { test encoding-8.1 {Tcl_ExternalToUtf} { set f [open [file join [temporaryDirectory] dummy] w] fconfigure $f -translation binary -encoding iso8859-1 - puts -nonewline $f "ab\x8c\xc1g" + puts -nonewline $f "ab\x8C\xC1g" close $f set f [open [file join [temporaryDirectory] dummy] r] fconfigure $f -translation binary -encoding shiftjis @@ -219,7 +219,7 @@ test encoding-10.1 {Tcl_UtfToExternal} { close $f file delete [file join [temporaryDirectory] dummy] return $x -} "ab\x8c\xc1g" +} "ab\x8C\xC1g" proc viewable {str} { set res "" @@ -227,7 +227,7 @@ proc viewable {str} { if {[string is print $c] && [string is ascii $c]} { append res $c } else { - append res "\\u[format %4.4x [scan $c %c]]" + append res "\\u[format %4.4X [scan $c %c]]" } } return "$str ($res)" @@ -258,7 +258,7 @@ test encoding-11.5 {LoadEncodingFile: escape file} { } [viewable "\x1B\$B8C\x1B(B"] test encoding-11.5.1 {LoadEncodingFile: escape file} { viewable [encoding convertto iso2022-jp 乎] -} [viewable "\x1b\$B8C\x1b(B"] +} [viewable "\x1B\$B8C\x1B(B"] test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup { set system [encoding system] set path [encoding dirs] @@ -283,24 +283,24 @@ test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} } -result {invalid encoding file "splat"} test encoding-11.8 {encoding: extended Unicode UTF-16} { viewable [encoding convertto utf-16le 😹] -} {=Ø9Þ (=\u00d89\u00de)} +} {=Ø9Þ (=\u00D89\u00DE)} test encoding-11.9 {encoding: extended Unicode UTF-16} { viewable [encoding convertto utf-16be 😹] -} {Ø=Þ9 (\u00d8=\u00de9)} +} {Ø=Þ9 (\u00D8=\u00DE9)} # OpenEncodingFile is fully tested by the rest of the tests in this file. test encoding-12.1 {LoadTableEncoding: normal encoding} { - set x [encoding convertto iso8859-3 \u0120] - append x [encoding convertto iso8859-3 \xD5] - append x [encoding convertfrom iso8859-3 \xD5] -} "\xD5?\u120" + set x [encoding convertto iso8859-3 Ġ] + append x [encoding convertto iso8859-3 Õ] + append x [encoding convertfrom iso8859-3 Õ] +} "Õ?Ġ" test encoding-12.2 {LoadTableEncoding: single-byte encoding} { - set x [encoding convertto iso8859-3 ab\u0120g] - append x [encoding convertfrom iso8859-3 ab\xD5g] -} "ab\xD5gab\u120g" + set x [encoding convertto iso8859-3 abĠg] + append x [encoding convertfrom iso8859-3 abÕg] +} "abÕgabĠg" test encoding-12.3 {LoadTableEncoding: multi-byte encoding} { set x [encoding convertto shiftjis ab乎g] - append x [encoding convertfrom shiftjis ab\x8c\xc1g] + append x [encoding convertfrom shiftjis ab\x8C\xC1g] } "ab\x8C\xC1gab乎g" test encoding-12.4 {LoadTableEncoding: double-byte encoding} { set x [encoding convertto jis0208 乎α] @@ -317,7 +317,7 @@ test encoding-13.1 {LoadEscapeTable} { } [viewable "ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg"] test encoding-15.1 {UtfToUtfProc} { - encoding convertto utf-8 \xA3 + encoding convertto utf-8 £ } "\xC2\xA3" test encoding-15.2 {UtfToUtfProc null character output} testbytestring { binary scan [testbytestring [encoding convertto utf-8 \x00]] H* z @@ -351,8 +351,8 @@ test encoding-15.7 {UtfToUtfProc emoji character output} { list [string length $x] [string length $y] $z } {3 9 edb882eda0bdeda0bd} test encoding-15.8 {UtfToUtfProc emoji character output} { - set x \uDE02\uD83D\xE9 - set y [encoding convertto utf-8 \uDE02\uD83D\xE9] + set x \uDE02\uD83Dé + set y [encoding convertto utf-8 \uDE02\uD83Dé] binary scan $y H* z list [string length $x] [string length $y] $z } {3 8 edb882eda0bdc3a9} @@ -363,14 +363,14 @@ test encoding-15.9 {UtfToUtfProc emoji character output} { list [string length $x] [string length $y] $z } {3 7 edb882eda0bd58} test encoding-15.10 {UtfToUtfProc high surrogate character output} { - set x \uDE02\xE9 - set y [encoding convertto utf-8 \uDE02\xE9] + set x \uDE02é + set y [encoding convertto utf-8 \uDE02é] binary scan $y H* z list [string length $x] [string length $y] $z } {2 5 edb882c3a9} test encoding-15.11 {UtfToUtfProc low surrogate character output} { - set x \uDA02\xE9 - set y [encoding convertto utf-8 \uDA02\xE9] + set x \uDA02é + set y [encoding convertto utf-8 \uDA02é] binary scan $y H* z list [string length $x] [string length $y] $z } {2 5 eda882c3a9} @@ -425,7 +425,7 @@ test encoding-16.3 {Utf16ToUtfProc} -body { test encoding-16.4 {Ucs2ToUtfProc} -body { set val [encoding convertfrom ucs-2 NN] list $val [format %x [scan $val %c]] -} -result "\u4E4E 4e4e" +} -result "乎 4e4e" test encoding-16.4 {Ucs2ToUtfProc} -body { set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"] list $val [format %x [scan $val %c]] @@ -459,18 +459,18 @@ test encoding-21.1 {EscapeToUtfProc} { test encoding-22.1 {EscapeFromUtfProc} { } {} -set iso2022encData "\u001b\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\u001b(B -\u001b\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\u001b(B -\u001b\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\u001b(B -casino_japanese@___.com \u001b\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\u001b(B -\u001b\$B\$7\$g\$&\$+!)\u001b(B" +set iso2022encData "\x1B\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\x1B(B +\x1B\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\x1B(B +\x1B\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\x1B(B +casino_japanese@___.com \x1B\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\x1B(B +\x1B\$B\$7\$g\$&\$+!)\x1B(B" set iso2022uniData [encoding convertfrom iso2022-jp $iso2022encData] -set iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3054\u8cfc\u5165\u6642\u306b\u3054\u767b\u9332\u3044\u305f\u3060\u3044\u305f\u3054\u4f4f\u6240\u3092\u30ad\u30e3\u30c3\u30b7\u30e5\u30a2\u30a6\u30c8\u306e\u969b\u306e -\u5c0f\u5207\u624b\u9001\u4ed8\u5148\u3068\u3057\u3066\u4f7f\u7528\u3057\u3066\u304a\u308a\u307e\u3059\u3002\u6050\u308c\u5165\u308a\u307e\u3059\u304c\u3001\u6b63\u3057\u3044\u4f4f\u6240\u3092\u3054\u767b\u9332\u3057\u306a\u304a -\u304a\u9858\u3044\u3044\u305f\u3057\u307e\u3059\u3002\u307e\u305f\u3001\u5927\u5909\u6050\u7e2e\u3067\u3059\u304c\u3001\u4f4f\u6240\u5909\u66f4\u306e\u3042\u3068\u3001\u65e5\u672c\u8a9e\u30b5\u30fc\u30d3\u30b9\u90e8\uff08 -\u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067 -\u3057\u3087\u3046\u304b\uff1f" +set iso2022uniData2 "私どもでは、チップご購入時にご登録いただいたご住所をキャッシュアウトの際の +小切手送付先として使用しております。恐れ入りますが、正しい住所をご登録しなお +お願いいたします。また、大変恐縮ですが、住所変更のあと、日本語サービス部( +casino_japanese@___.com )までご住所変更済の連絡をいただけないで +しょうか?" cd [temporaryDirectory] set fid [open iso2022.txt w] @@ -539,7 +539,7 @@ test encoding-24.2 {EscapeFreeProc on open channels} {exec} { set env(TCL_FINALIZE_ON_EXIT) 1 exit }] -} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)" +} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001B\$B8C\\u001B\$(DD%\\u001B(Bg)" test encoding-24.3 {EscapeFreeProc on open channels} {stdio} { # Bug #219314 - if we don't free escape encodings correctly on channel # closure, we go boom @@ -554,7 +554,7 @@ test encoding-24.3 {EscapeFreeProc on open channels} {stdio} { close $f removeFile iso2022.tcl list $count [viewable $line] -} [list 3 "乎乞也 (\\u4e4e\\u4e5e\\u4e5f)"] +} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"] test encoding-24.4 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC0\x80"] @@ -632,20 +632,20 @@ proc foreach-jisx0208 {varName command} { } proc gen-jisx0208-euc-jp {code} { binary format cc \ - [expr {($code >> 8) | 0x80}] [expr {($code & 0xff) | 0x80}] + [expr {($code >> 8) | 0x80}] [expr {($code & 0xFF) | 0x80}] } proc gen-jisx0208-iso2022-jp {code} { binary format a3cca3 \ - "\x1b\$B" [expr {$code >> 8}] [expr {$code & 0xff}] "\x1b(B" + "\x1B\$B" [expr {$code >> 8}] [expr {$code & 0xFF}] "\x1B(B" } proc gen-jisx0208-cp932 {code} { set c1 [expr {($code >> 8) | 0x80}] set c2 [expr {($code & 0xff)| 0x80}] if {$c1 % 2} { - set c1 [expr {($c1 >> 1) + ($c1 < 0xdf ? 0x31 : 0x71)}] - incr c2 [expr {- (0x60 + ($c2 < 0xe0))}] + set c1 [expr {($c1 >> 1) + ($c1 < 0xDF ? 0x31 : 0x71)}] + incr c2 [expr {- (0x60 + ($c2 < 0xE0))}] } else { - set c1 [expr {($c1 >> 1) + ($c1 < 0xdf ? 0x30 : 0x70)}] + set c1 [expr {($c1 >> 1) + ($c1 < 0xDF ? 0x30 : 0x70)}] incr c2 -2 } binary format cc $c1 $c2 diff --git a/tests/exec.test b/tests/exec.test index 412cd4c..6e4718a 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -169,19 +169,19 @@ test exec-2.6 {redirecting input from immediate source, with UTF} -setup { encoding system iso8859-1 proc quotenonascii s { regsub -all {\[|\\|\]} $s {\\&} s - regsub -all "\[\u007f-\uffff\]" $s \ - {[apply {c {format {\u%04x} [scan $c %c]}} &]} s + regsub -all "\[\x7F-\xFF\]" $s \ + {[apply {c {format {\x%02X} [scan $c %c]}} &]} s return [subst -novariables $s] } } -constraints {exec} -body { - # If this fails, it may give back: "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1" + # If this fails, it may give back: "\xC3\xA9\xC3\xA0\xC3\xBC\xC3\xB1" # If it does, this means that the UTF -> external conversion did not occur # before writing out the temp file. - quotenonascii [exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"] + quotenonascii [exec [interpreter] $path(cat) << "\xE9\xE0\xFC\xF1"] } -cleanup { encoding system $sysenc rename quotenonascii {} -} -result {\u00e9\u00e0\u00fc\u00f1} +} -result {\xE9\xE0\xFC\xF1} # I/O redirection: output to file. diff --git a/tests/execute.test b/tests/execute.test index 8a1cde0..6d8ce99 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -1062,7 +1062,7 @@ test execute-9.1 {Interp result resetting [Bug 1522803]} { } SUCCESS test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { - apply {s {binary scan [binary format a $s] c x; list $x [scan $s$s %c%c]}} \u0130 + apply {s {binary scan [binary format a $s] c x; list $x [scan $s$s %c%c]}} İ } {48 {304 304}} test execute-10.2 {Bug 2802881} -setup { interp create child diff --git a/tests/expr-old.test b/tests/expr-old.test index f942964..7344e08 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -35,9 +35,9 @@ proc testIEEE {} { switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian - binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \ ieeeValues(-Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) @@ -47,19 +47,19 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \ ieeeValues(+Normal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \ ieeeValues(+Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { - binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) - binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) @@ -69,11 +69,11 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) - binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) - binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) - binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 diff --git a/tests/expr.test b/tests/expr.test index 982cd43..5c1f6d9 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -32,9 +32,9 @@ proc testIEEE {} { switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian - binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \ ieeeValues(-Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) @@ -44,21 +44,21 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \ ieeeValues(+Normal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \ ieeeValues(+Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \ ieeeValues(NaN) - binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\xFF d \ ieeeValues(-NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { - binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) - binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) @@ -68,13 +68,13 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) - binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) - binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) - binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) - binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-NaN) set ieeeValues(littleEndian) 0 return 1 @@ -350,7 +350,7 @@ test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body { expr 2!=x } -returnCodes error -match glob -result * test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1 -test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \u00fc]}} 1 +test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \xFC]}} 1 test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0 test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1 diff --git a/tests/fCmd.test b/tests/fCmd.test index 6a909f8..d1d1930 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -271,7 +271,7 @@ test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup { file mkdir td1 file rename ~_totally_bogus_user td1 } -result {user "_totally_bogus_user" doesn't exist} -test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup { +test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup { cleanup } -constraints {notRoot unixOrWin} -returnCodes error -body { file mkdir td1 @@ -313,7 +313,7 @@ test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup { } -constraints {notRoot} -returnCodes error -body { file mkdir ~_totally_bogus_user } -result {user "_totally_bogus_user" doesn't exist} -test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setup { +test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\x00'} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir "" diff --git a/tests/fileSystemEncoding.test b/tests/fileSystemEncoding.test index 848b570..c9d36d2 100644 --- a/tests/fileSystemEncoding.test +++ b/tests/fileSystemEncoding.test @@ -13,7 +13,7 @@ namespace eval ::tcl::test::fileSystemEncoding { namespace import -force ::tcltest::* } - variable fname1 \u767b\u9e1b\u9d72\u6a13 + variable fname1 登鸛鵲樓 proc autopath {} { global auto_path diff --git a/tests/format.test b/tests/format.test index 7fcefa4..af2e4ff 100644 --- a/tests/format.test +++ b/tests/format.test @@ -105,17 +105,17 @@ test format-2.4 {string formatting} { format "%s %s %% %c %s" abcd {This is a very long test string.} 120 x } {abcd This is a very long test string. % x x} test format-2.5 {string formatting, embedded nulls} { - format "%10s" abc\0def -} " abc\0def" + format "%10s" abc\x00def +} " abc\x00def" test format-2.6 {string formatting, international chars} { - format "%10s" abc\ufeffdef -} " abc\ufeffdef" + format "%10s" abc\uFEFFdef +} " abc\uFEFFdef" test format-2.7 {string formatting, international chars} { - format "%.5s" abc\ufeffdef -} "abc\ufeffd" + format "%.5s" abc\uFEFFdef +} "abc\uFEFFd" test format-2.8 {string formatting, international chars} { - format "foo\ufeffbar%s" baz -} "foo\ufeffbarbaz" + format "foo\uFEFFbar%s" baz +} "foo\uFEFFbarbaz" test format-2.9 {string formatting, width} { format "a%5sa" f } "a fa" @@ -148,8 +148,8 @@ test format-3.1 {Tcl_FormatObjCmd: character formatting} { format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65 } "|A|A|A|A|A | A| A|A |" test format-3.2 {Tcl_FormatObjCmd: international character formatting} { - format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xa2 0x4e4e 0x25a 0xc3 0xff08 0 3 0x6575 -4 0x4e4f -} "|\ua2|\u4e4e|\u25a|\uc3|\uff08 | \0| \u6575|\u4e4f |" + format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xA2 0x4E4E 0x25A 0xC3 0xFF08 0 3 0x6575 -4 0x4E4F +} "|¢|乎|ɚ|Ã|( | \x00| 敵|乏 |" test format-4.1 {e and f formats} {eformat} { format "%e %e %e %e" 34.2e12 68.514 -.125 -16000. .000053 diff --git a/tests/http.test b/tests/http.test index ff9fb78..2fd5af4 100644 --- a/tests/http.test +++ b/tests/http.test @@ -42,7 +42,7 @@ proc bgerror {args} { # Name resolution is often a problem on OSX; not focus of HTTP package anyway. # Also a problem on other platforms for http-4.14 (test with bad port number). set HOST localhost -set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" +set bindata "This is binary data\x0D\x0Amore\x0Dmore\x0Amore\x00null" catch {unset data} # Ensure httpd file exists @@ -620,12 +620,12 @@ test http-5.3 {http::formatQuery} { http::formatQuery lines "line1\nline2\nline3" } {lines=line1%0D%0Aline2%0D%0Aline3} test http-5.4 {http::formatQuery} { - http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 + http::formatQuery name1 ~bwelch name2 ¡¢¢ } {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2} test http-5.5 {http::formatQuery} { set enc [http::config -urlencoding] http::config -urlencoding iso8859-1 - set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2] + set res [http::formatQuery name1 ~bwelch name2 ¡¢¢] http::config -urlencoding $enc set res } {name1=~bwelch&name2=%A1%A2%A2} @@ -650,24 +650,24 @@ test http-7.1 {http::mapReply} { test http-7.2 {http::mapReply} { # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default, # so make sure this gets converted to utf-8 then urlencoded. - http::mapReply "\u2208" + http::mapReply "∈" } {%E2%88%88} test http-7.3 {http::formatQuery} -setup { set enc [http::config -urlencoding] } -returnCodes error -body { # this would be reverting to http <=2.4 behavior http::config -urlencoding "" - http::mapReply "\u2208" + http::mapReply "∈" } -cleanup { http::config -urlencoding $enc -} -result "can't read \"formMap(\u2208)\": no such element in array" +} -result "can't read \"formMap(∈)\": no such element in array" test http-7.4 {http::formatQuery} -setup { set enc [http::config -urlencoding] } -body { # this would be reverting to http <=2.4 behavior w/o errors # (unknown chars become '?') http::config -urlencoding "iso8859-1" - http::mapReply "\u2208" + http::mapReply "∈" } -cleanup { http::config -urlencoding $enc } -result {%3F} @@ -715,37 +715,37 @@ test http-idna-2.1 {puny encode: functional test} { ::tcl::idna puny encode abc } abc- test http-idna-2.2 {puny encode: functional test} { - ::tcl::idna puny encode a\u20acb\u20acc + ::tcl::idna puny encode a€b€c } abc-k50ab test http-idna-2.3 {puny encode: functional test} { ::tcl::idna puny encode ABC } ABC- test http-idna-2.4 {puny encode: functional test} { - ::tcl::idna puny encode A\u20ACB\u20ACC + ::tcl::idna puny encode A€B€C } ABC-k50ab test http-idna-2.5 {puny encode: functional test} { ::tcl::idna puny encode ABC 0 } abc- test http-idna-2.6 {puny encode: functional test} { - ::tcl::idna puny encode A\u20ACB\u20ACC 0 + ::tcl::idna puny encode A€B€C 0 } abc-k50ab test http-idna-2.7 {puny encode: functional test} { ::tcl::idna puny encode ABC 1 } ABC- test http-idna-2.8 {puny encode: functional test} { - ::tcl::idna puny encode A\u20ACB\u20ACC 1 + ::tcl::idna puny encode A€B€C 1 } ABC-k50ab test http-idna-2.9 {puny encode: functional test} { ::tcl::idna puny encode abc 0 } abc- test http-idna-2.10 {puny encode: functional test} { - ::tcl::idna puny encode a\u20ACb\u20ACc 0 + ::tcl::idna puny encode a€b€c 0 } abc-k50ab test http-idna-2.11 {puny encode: functional test} { ::tcl::idna puny encode abc 1 } ABC- test http-idna-2.12 {puny encode: functional test} { - ::tcl::idna puny encode a\u20ACb\u20ACc 1 + ::tcl::idna puny encode a€b€c 1 } ABC-k50ab test http-idna-2.13 {puny encode: edge cases} { ::tcl::idna puny encode "" @@ -875,43 +875,43 @@ test http-idna-3.1 {puny decode: functional test} { } abc test http-idna-3.2 {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab -} a\u20acb\u20acc +} a€b€c test http-idna-3.3 {puny decode: functional test} { ::tcl::idna puny decode ABC- } ABC test http-idna-3.4 {puny decode: functional test} { ::tcl::idna puny decode ABC-k50ab -} A\u20ACB\u20ACC +} A€B€C test http-idna-3.5 {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB -} A\u20ACB\u20ACC +} A€B€C test http-idna-3.6 {puny decode: functional test} { ::tcl::idna puny decode abc-K50AB -} a\u20ACb\u20ACc +} a€b€c test http-idna-3.7 {puny decode: functional test} { ::tcl::idna puny decode ABC- 0 } abc test http-idna-3.8 {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB 0 -} a\u20ACb\u20ACc +} a€b€c test http-idna-3.9 {puny decode: functional test} { ::tcl::idna puny decode ABC- 1 } ABC test http-idna-3.10 {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB 1 -} A\u20ACB\u20ACC +} A€B€C test http-idna-3.11 {puny decode: functional test} { ::tcl::idna puny decode abc- 0 } abc test http-idna-3.12 {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab 0 -} a\u20ACb\u20ACc +} a€b€c test http-idna-3.13 {puny decode: functional test} { ::tcl::idna puny decode abc- 1 } ABC test http-idna-3.14 {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab 1 -} A\u20ACB\u20ACC +} A€B€C test http-idna-3.15 {puny decode: edge cases and errors} { # Is this case actually correct? binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]] @@ -1045,16 +1045,16 @@ test http-idna-4.1 {IDNA encoding} { ::tcl::idna encode abc.def } abc.def test http-idna-4.2 {IDNA encoding} { - ::tcl::idna encode a\u20acb\u20acc.def + ::tcl::idna encode a€b€c.def } xn--abc-k50ab.def test http-idna-4.3 {IDNA encoding} { - ::tcl::idna encode def.a\u20acb\u20acc + ::tcl::idna encode def.a€b€c } def.xn--abc-k50ab test http-idna-4.4 {IDNA encoding} { ::tcl::idna encode ABC.DEF } ABC.DEF test http-idna-4.5 {IDNA encoding} { - ::tcl::idna encode A\u20acB\u20acC.def + ::tcl::idna encode A€B€C.def } xn--ABC-k50ab.def test http-idna-4.6 {IDNA encoding: invalid edge case} { # Should this be an error? @@ -1084,7 +1084,7 @@ test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} { } {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c} unset overlong test http-idna-4.10 {IDNA encoding: edge cases} { - ::tcl::idna encode pass\u00e9.example.com + ::tcl::idna encode passé.example.com } xn--pass-epa.example.com test http-idna-5.1 {IDNA decoding} { diff --git a/tests/init.test b/tests/init.test index 0074625..4acad3d 100644 --- a/tests/init.test +++ b/tests/init.test @@ -155,7 +155,7 @@ foreach arg [subst -nocommands -novariables { error stack cannot be uniquely determined. foo bar "} - {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library} + {argument that contains non-ASCII character, €, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library} }] { ;# emacs needs -> " test init-4.$count.0 {::errorInfo produced by [unknown]} -setup { diff --git a/tests/io.test b/tests/io.test index 0d75116..e0a2389 100644 --- a/tests/io.test +++ b/tests/io.test @@ -108,17 +108,17 @@ set path(test1) [makeFile {} test1] test io-1.6 {Tcl_WriteChars: WriteBytes} { set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f "a\u4e4d\0" + puts -nonewline $f "a乍\x00" close $f contents $path(test1) -} "a\x4d\x00" +} "a\x4D\x00" test io-1.7 {Tcl_WriteChars: WriteChars} { set f [open $path(test1) w] fconfigure $f -encoding shiftjis - puts -nonewline $f "a\u4e4d\0" + puts -nonewline $f "a乍\x00" close $f contents $path(test1) -} "a\x93\xe1\x00" +} "a\x93\xE1\x00" set path(test2) [makeFile {} test2] test io-1.8 {Tcl_WriteChars: WriteChars} { # This test written for SF bug #506297. @@ -132,7 +132,7 @@ test io-1.8 {Tcl_WriteChars: WriteChars} { puts -nonewline $f [format %s%c [string repeat " " 4] 12399] close $f contents $path(test2) -} " \x1b\$B\$O\x1b(B" +} " \x1B\$B\$O\x1B(B" test io-1.9 {Tcl_WriteChars: WriteChars} { # When closing a channel with an encoding that appends @@ -295,14 +295,14 @@ test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} { # in src to the beginning of that UTF-8 character and try again. # # Translate the first 16 bytes, produce 14 bytes of output, 2 left over - # (first two bytes of \uff21 in UTF-8). Given those two bytes try + # (first two bytes of A in UTF-8). Given those two bytes try # translating them again, find that no bytes are read produced, and break # to outer loop where those two bytes will have the remaining 4 bytes - # (the last byte of \uff21 plus the all of \uff22) appended. + # (the last byte of A plus the all of B) appended. set f [open $path(test1) w] fconfigure $f -encoding shiftjis -buffersize 16 - puts -nonewline $f "12345678901234\uff21\uff22" + puts -nonewline $f "12345678901234AB" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] @@ -451,7 +451,7 @@ test io-6.3 {Tcl_GetsObj: how many have we used?} { test io-6.4 {Tcl_GetsObj: encoding == NULL} { set f [open $path(test1) w] fconfigure $f -translation binary - puts $f "\x81\u1234\0" + puts $f "\x81\u1234\x00" close $f set f [open $path(test1)] fconfigure $f -translation binary @@ -462,14 +462,14 @@ test io-6.4 {Tcl_GetsObj: encoding == NULL} { test io-6.5 {Tcl_GetsObj: encoding != NULL} { set f [open $path(test1) w] fconfigure $f -translation binary - puts $f "\x88\xea\x92\x9a" + puts $f "\x88\xEA\x92\x9A" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis set x [list [gets $f line] $line] close $f set x -} [list 2 "\u4e00\u4e01"] +} [list 2 "一丁"] set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" append a $a append a $a @@ -509,7 +509,7 @@ test io-6.8 {Tcl_GetsObj: remember if EOF is seen} { } {6 abcdef -1 {}} test io-6.9 {Tcl_GetsObj: remember if EOF is seen} { set f [open $path(test1) w] - puts $f "abcdefghijk\nwom\u001abat" + puts $f "abcdefghijk\nwom\x1Abat" close $f set f [open $path(test1)] fconfigure $f -eofchar \x1A @@ -1052,14 +1052,14 @@ test io-6.55 {Tcl_GetsObj: overconverted} { set f [open $path(test1) w] fconfigure $f -encoding iso2022-jp - puts $f "there\u4e00ok\n\u4e01more bytes\nhere" + puts $f "there一ok\n丁more bytes\nhere" close $f set f [open $path(test1)] fconfigure $f -encoding iso2022-jp set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line] close $f set x -} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"] +} [list 8 "there一ok" 11 "丁more bytes" 4 "here"] test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} { update set f [open "|[list [interpreter] $path(cat)]" w+] @@ -1086,20 +1086,20 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} { set f [open $path(test1) w] fconfigure $f -encoding shiftjis - puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend" + puts $f "123456789012301234\nend" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis -buffersize 16 set x [gets $f] close $f set x -} "1234567890123\uff10\uff11\uff12\uff13\uff14" +} "123456789012301234" test io-7.2 {FilterInputBytes: split up character in middle of buffer} { # (bufPtr->nextAdded < bufPtr->bufLength) set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82" + puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis @@ -1110,7 +1110,7 @@ test io-7.2 {FilterInputBytes: split up character in middle of buffer} { test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} { set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" + puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis @@ -1119,11 +1119,11 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} { lappend x [gets $f line] $line close $f set x -} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""] +} [list 15 "123456789012301" 18 0 1 -1 ""] test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} { set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -encoding binary -buffering none - puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" + puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" fconfigure $f -encoding shiftjis -blocking 0 fileevent $f read [namespace code "ready $f"] variable x {} @@ -1138,7 +1138,7 @@ test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent vwait [namespace which -variable x] close $f set x -} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0] +} [list -1 "" 1 17 "12345678901230123" 0] test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} { # (bufPtr->nextPtr == NULL) @@ -1415,19 +1415,19 @@ test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} { fconfigure $f -encoding shiftjis vwait [namespace which -variable x] fconfigure $f -encoding binary -blocking 1 - puts -nonewline $f "\x7b" + puts -nonewline $f "\x7B" after 500 ;# Give the cat process time to catch up fconfigure $f -encoding shiftjis -blocking 0 vwait [namespace which -variable x] close $f set x -} [list "123456789012345" 1 "\u672c" 0] +} [list "123456789012345" 1 "本" 0] test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} { set path(test1) [makeFile { fconfigure stdout -encoding binary -buffering none - gets stdin; puts -nonewline "\xe7" + gets stdin; puts -nonewline "\xE7" gets stdin; puts -nonewline "\x89" - gets stdin; puts -nonewline "\xa6" + gets stdin; puts -nonewline "\xA6" } test1] set f [open "|[list [interpreter] $path(test1)]" r+] fileevent $f readable [namespace code { @@ -1454,7 +1454,7 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} { vwait [namespace which -variable x] lappend x [catch {close $f} msg] $msg set x -} "{} timeout {} timeout \u7266 {} eof 0 {}" +} "{} timeout {} timeout 牦 {} eof 0 {}" test io-12.6 {ReadChars: too many chars read} { proc driver {cmd args} { variable buffer @@ -1464,7 +1464,7 @@ test io-12.6 {ReadChars: too many chars read} { initialize { set index($chan) 0 set buffer($chan) [encoding convertto utf-8 \ - [string repeat \uBEEF 20][string repeat . 20]] + [string repeat 뻯 20][string repeat . 20]] return {initialize finalize watch read} } finalize { @@ -1497,7 +1497,7 @@ test io-12.7 {ReadChars: too many chars read [bc5b790099]} { initialize { set index($chan) 0 set buffer($chan) [encoding convertto utf-8 \ - [string repeat \uBEEF 10]....\uBEEF] + [string repeat 뻯 10]....뻯] return {initialize finalize watch read} } finalize { @@ -1524,7 +1524,7 @@ test io-12.7 {ReadChars: too many chars read [bc5b790099]} { test io-12.8 {ReadChars: multibyte chars split} { set f [open $path(test1) w] fconfigure $f -translation binary - puts -nonewline $f [string repeat a 9]\xc2\xa0 + puts -nonewline $f [string repeat a 9]\xC2\xA0 close $f set f [open $path(test1)] fconfigure $f -encoding utf-8 -buffersize 10 @@ -1535,7 +1535,7 @@ test io-12.8 {ReadChars: multibyte chars split} { test io-12.9 {ReadChars: multibyte chars split} { set f [open $path(test1) w] fconfigure $f -translation binary - puts -nonewline $f [string repeat a 9]\xc2 + puts -nonewline $f [string repeat a 9]\xC2 close $f set f [open $path(test1)] fconfigure $f -encoding utf-8 -buffersize 10 @@ -1546,7 +1546,7 @@ test io-12.9 {ReadChars: multibyte chars split} { test io-12.10 {ReadChars: multibyte chars split} { set f [open $path(test1) w] fconfigure $f -translation binary - puts -nonewline $f [string repeat a 9]\xc2 + puts -nonewline $f [string repeat a 9]\xC2 close $f set f [open $path(test1)] fconfigure $f -encoding utf-8 -buffersize 11 @@ -1732,7 +1732,7 @@ test io-13.10 {TranslateInputEOL: auto mode: \n} { set x } "abcd\ndef" test io-13.11 {TranslateInputEOL: EOF char} { - # (*chanPtr->inEofChar != '\0') + # (*chanPtr->inEofChar != '\x00') set f [open $path(test1) w] fconfigure $f -translation lf @@ -1745,7 +1745,7 @@ test io-13.11 {TranslateInputEOL: EOF char} { set x } "abcd\nd" test io-13.12 {TranslateInputEOL: find EOF char in src} { - # (*chanPtr->inEofChar != '\0') + # (*chanPtr->inEofChar != '\x00') set f [open $path(test1) w] fconfigure $f -translation lf @@ -3202,7 +3202,7 @@ test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} { puts -nonewline $f hello\nthere\nand\rhere\n\x1A close $f set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A set c [read $f] close $f set c @@ -3214,11 +3214,11 @@ here test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -eofchar \x1A -translation lf + fconfigure $f -translation lf -eofchar \x1A puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A set c [read $f] close $f set c @@ -3235,7 +3235,7 @@ test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3255,7 +3255,7 @@ test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3736,7 +3736,7 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3751,11 +3751,11 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -eofchar \x1A -translation lf + fconfigure $f -translation lf -eofchar \x1A puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3775,8 +3775,7 @@ test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -eofchar \x1A - fconfigure $f -translation auto + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3794,7 +3793,7 @@ test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -5479,26 +5478,26 @@ test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -encoding {} - puts -nonewline $f \xe7\x89\xa6 + puts -nonewline $f \xE7\x89\xA6 close $f set f [open $path(test1) r] fconfigure $f -encoding utf-8 set x [read $f] close $f set x -} \u7266 +} 牦 test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f \xe7\x89\xa6 + puts -nonewline $f \xE7\x89\xA6 close $f set f [open $path(test1) r] fconfigure $f -encoding utf-8 set x [read $f] close $f set x -} \u7266 +} 牦 test io-39.16 {Tcl_SetChannelOption: -encoding, errors} { file delete $path(test1) set f [open $path(test1) w] @@ -5509,7 +5508,7 @@ test io-39.16 {Tcl_SetChannelOption: -encoding, errors} { test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} { set f [open "|[list [interpreter] $path(cat)]" r+] fconfigure $f -encoding binary - puts -nonewline $f "\xe7" + puts -nonewline $f "\xE7" flush $f fconfigure $f -encoding utf-8 -blocking 0 variable x {} @@ -5527,7 +5526,7 @@ test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} vwait [namespace which -variable x] close $f set x -} "{} timeout {} timeout \xe7 timeout" +} "{} timeout {} timeout \xE7 timeout" test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} @@ -5830,11 +5829,11 @@ test io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} { } {{first script} {new script} {yet another} {}} test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} { set result {} - fileevent $f r "first scr\0ipt" + fileevent $f r "first scr\x00ipt" lappend result [string length [fileevent $f readable]] - fileevent $f r "new scr\0ipt" + fileevent $f r "new scr\x00ipt" lappend result [string length [fileevent $f readable]] - fileevent $f r "yet ano\0ther" + fileevent $f r "yet ano\x00ther" lappend result [string length [fileevent $f readable]] fileevent $f r "" lappend result [fileevent $f readable] @@ -6391,7 +6390,7 @@ test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {file set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6447,7 +6446,7 @@ test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {file set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6503,7 +6502,7 @@ test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation auto + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6531,7 +6530,7 @@ test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation lf + fconfigure $f -translation lf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6587,7 +6586,7 @@ test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation cr + fconfigure $f -translation cr -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6643,7 +6642,7 @@ test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {f set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -eofchar \x1A -translation crlf + fconfigure $f -translation crlf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -7218,7 +7217,7 @@ set path(utf8-rp.txt) [makeFile {} utf8-rp.txt] # Create kyrillic file, use lf translation to avoid os eol issues set out [open $path(kyrillic.txt) w] fconfigure $out -encoding koi8-r -translation lf -puts $out "\u0410\u0410" +puts $out "АА" close $out test io-52.9 {TclCopyChannel & encodings} {fcopy} { # Copy kyrillic to UTF-8, using fcopy. @@ -7270,7 +7269,7 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy} { test io-52.11 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf - puts $out "\u0410\u0410" + puts $out "АА" close $out } -constraints {fcopy} -body { # binary to encoding => the input has to be @@ -8390,7 +8389,7 @@ test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} { set out [open $path(script) w] puts $out "catch {load $::tcltestlib Tcltest}" puts $out { - puts [testbytestring \xe2] + puts [testbytestring \xE2] exit 1 } proc readit {pipe} { @@ -8748,7 +8747,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup { read $rfd } -body { set result [eof $rfd] - puts -nonewline $wfd "more\u00c2\u00a0data" + puts -nonewline $wfd "more\xC2\xA0data" lappend result [eof $rfd] lappend result [read $rfd] lappend result [eof $rfd] @@ -8756,7 +8755,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup { close $wfd close $rfd removeFile io-73.5 -} -result [list 1 1 more\u00a0data 1] +} -result [list 1 1 more\xA0data 1] test io-74.1 {[104f2885bb] improper cache validity check} -setup { set fn [makeFile {} io-74.1] diff --git a/tests/ioCmd.test b/tests/ioCmd.test index bdf162d..dbca866 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -494,14 +494,14 @@ test iocmd-12.10 {POSIX open access modes: BINARY} { } 5 test iocmd-12.11 {POSIX open access modes: BINARY} { set f [open $path(test1) {WRONLY BINARY TRUNC}] - puts $f \u0248 ;# gets truncated to \u0048 + puts $f Ɉ ;# gets truncated to H close $f set f [open $path(test1) r] fconfigure $f -translation binary set result [read -nonewline $f] close $f set result -} \u0048 +} H test iocmd-13.1 {errors in open command} { list [catch {open} msg] $msg diff --git a/tests/list.test b/tests/list.test index 4cd3a75..905a3d3 100644 --- a/tests/list.test +++ b/tests/list.test @@ -45,23 +45,23 @@ test list-1.24 {basic tests} {list} {} test list-1.25 {basic tests} {list # #} {{#} #} test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{} test list-1.27 {basic null treatment} { - set l [list "" "\0" "\0\0"] - set e "{} \0 \0\0" + set l [list "" "\x00" "\x00\x00"] + set e "{} \x00 \x00\x00" string equal $l $e } 1 test list-1.28 {basic null treatment} { - set result "\0a\0b" + set result "\x00a\x00b" list $result [string length $result] -} "\0a\0b 4" +} "\x00a\x00b 4" test list-1.29 {basic null treatment} { - set result "\0a\0b" + set result "\x00a\x00b" set srep "$result 4" set lrep [list $result [string length $result]] string equal $srep $lrep } 1 test list-1.30 {basic null treatment} { - set l [list "\0abc" "xyz"] - set e "\0abc xyz" + set l [list "\x00abc" "xyz"] + set e "\x00abc xyz" string equal $l $e } 1 diff --git a/tests/lsearch.test b/tests/lsearch.test index 06f3ae4..7c1402d 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -102,13 +102,13 @@ test lsearch-3.7 {lsearch errors} -returnCodes error -body { } -result {-subindices cannot be used without -index option} test lsearch-4.1 {binary data} { - lsearch -exact [list foo one\000two bar] bar + lsearch -exact [list foo one\x00two bar] bar } 2 test lsearch-4.2 {binary data} { set x one append x \x00 append x two - lsearch -exact [list foo one\000two bar] $x + lsearch -exact [list foo one\x00two bar] $x } 1 # Make a sorted list diff --git a/tests/main.test b/tests/main.test index 37f87b4..2d3f63c 100644 --- a/tests/main.test +++ b/tests/main.test @@ -68,56 +68,56 @@ namespace eval ::tcl::test::main { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script - catch {set f [open "|[list [interpreter] script \u00c0]" r]} + catch {set f [open "|[list [interpreter] script À]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script [list [encoding convertfrom [encoding system] \ - [encoding convertto [encoding system] \u00c0]]] 0]\n + [encoding convertto [encoding system] À]]] 0]\n test Tcl_Main-1.4 { } -constraints { stdio } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script - catch {set f [open "|[list [interpreter] script \u20ac]" r]} + catch {set f [open "|[list [interpreter] script €]" r]} } -body { read $f } -cleanup { close $f removeFile script } -result [list script [list [encoding convertfrom [encoding system] \ - [encoding convertto [encoding system] \u20ac]]] 0]\n + [encoding convertto [encoding system] €]]] 0]\n test Tcl_Main-1.5 { } -constraints { stdio } -setup { - makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0 - catch {set f [open "|[list [interpreter] \u00c0]" r]} + makeFile {puts [list $argv0 $argv $tcl_interactive]} À + catch {set f [open "|[list [interpreter] À]" r]} } -body { read $f } -cleanup { close $f - removeFile \u00c0 + removeFile À } -result [list [list [encoding convertfrom [encoding system] \ - [encoding convertto [encoding system] \u00c0]]] {} 0]\n + [encoding convertto [encoding system] À]]] {} 0]\n test Tcl_Main-1.6 { } -constraints { stdio } -setup { - makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac - catch {set f [open "|[list [interpreter] \u20ac]" r]} + makeFile {puts [list $argv0 $argv $tcl_interactive]} € + catch {set f [open "|[list [interpreter] €]" r]} } -body { read $f } -cleanup { close $f - removeFile \u20ac + removeFile € } -result [list [list [encoding convertfrom [encoding system] \ - [encoding convertto [encoding system] \u20ac]]] {} 0]\n + [encoding convertto [encoding system] €]]] {} 0]\n test Tcl_Main-1.7 { Tcl_Main: startup script - -encoding option @@ -129,8 +129,8 @@ namespace eval ::tcl::test::main { set f [open $script w] chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]" + puts -nonewline $f {puts [string equal € } + puts $f "€]" close $f catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} } -body { @@ -151,7 +151,7 @@ namespace eval ::tcl::test::main { chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]" + puts $f "€]" close $f catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} } -body { @@ -172,7 +172,7 @@ namespace eval ::tcl::test::main { chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]" + puts $f "€]" close $f catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} } -body { @@ -606,8 +606,8 @@ namespace eval ::tcl::test::main { catch {set f [open "|[list [interpreter]]" w+]} catch {chan configure $f -blocking 0} } -body { - type $f "chan configure stdin -eofchar \"\\032 {}\" - if 1 \{\n\032" + type $f "chan configure stdin -eofchar \"\\x1A {}\" + if 1 \{\n\x1A" variable wait chan event $f readable \ [list set [namespace which -variable wait] "child exit"] diff --git a/tests/namespace.test b/tests/namespace.test index 3394824..679b468 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3301,8 +3301,8 @@ test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} { namespace eval ::testing { namespace eval abc {proc xyz {} {}} namespace eval def {proc xyz {} {}} - trace add command abc::xyz delete "namespace delete ::testing::def {}; #" - trace add command def::xyz delete "namespace delete ::testing::abc {}; #" + trace add command abc::xyz delete "namespace delete ::testing::def; #" + trace add command def::xyz delete "namespace delete ::testing::abc; #" } namespace delete ::testing } {} diff --git a/tests/obj.test b/tests/obj.test index 5576686..eb85c84 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -250,10 +250,10 @@ test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} testobj } {{} 1 {expected boolean value but got ""}} test obj-13.8 {SetBooleanFromAny, unicode strings} testobj { set result "" - lappend result [teststringobj set 1 1\u7777] + lappend result [teststringobj set 1 1睷] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg -} "1\u7777 1 {expected boolean value but got \"1\u7777\"}" +} "1睷 1 {expected boolean value but got \"1睷\"}" test obj-14.1 {UpdateStringOfBoolean} testobj { set result "" diff --git a/tests/oo.test b/tests/oo.test index 168baee..7980f9e 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1734,6 +1734,7 @@ test oo-11.6.3 { } -result 0 -cleanup { } + test oo-11.6.4 { OO: cleanup ReleaseClassContents() where class is mixed into one of its instances @@ -1754,6 +1755,34 @@ test oo-11.6.4 { rename obj1 {} } + +test oo-11.7 { + When an object is deleted its namespace is deleted, and all objects it is + mixed into are also deleted. If the object has been renamed into the + namespace of one of the objects it has been mixed into, the routine for the + object might get entirely deleted before the namespace of the object is + entirely deleted, in which case the C routine that performs the namespace + deletion either must either understand that the handle on the routine for + the object might now be gone, or it must be guaranteed that the handle does + not disappear until that routine is finished. +} -setup { +} -body { + oo::class create class1 + + oo::object create obj1 + oo::objdefine obj1 { + mixin ::class1 + } + set obj1ns [info object namespace obj1] + set class1ns [info object namespace class1] + rename class1 ${obj1ns}::class1 + # No segmentation fault + namespace delete $class1ns + return done +} -cleanup { +} -result done + + test oo-12.1 {OO: filters} { oo::class create Aclass Aclass create Aobject @@ -1777,6 +1806,8 @@ test oo-12.1 {OO: filters} { Aclass destroy return $result } {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345} + + test oo-12.2 {OO: filters} -setup { oo::class create Aclass Aclass create Aobject @@ -4376,12 +4407,13 @@ test oo-35.6 { } -body { rename obj2 {} rename obj1 {} - # doesn't crash + # No segmentation fault return done } -cleanup { rename obj {} } -result done + test oo-36.1 {TIP #470: introspection within oo::define} { oo::define oo::object self } ::oo::object diff --git a/tests/parse.test b/tests/parse.test index d655478..5b38318 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -31,7 +31,7 @@ testConstraint testevent [llength [info commands testevent]] testConstraint memory [llength [info commands memory]] test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {testparser testbytestring} { - testparser [testbytestring "foo\0 bar"] -1 + testparser [testbytestring "foo\x00 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser { testparser "foo bar" -1 @@ -300,8 +300,8 @@ test parse-6.15 {ParseTokens procedure, backslash-newline} testparser { testparser "\"b\\\nc\"" 0 } {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}} test parse-6.16 {ParseTokens procedure, backslash substitution} testparser { - testparser {\n\a\x7f} 0 -} {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}} + testparser {\n\a\x7F} 0 +} {- {\n\a\x7F} 1 word {\n\a\x7F} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7F} 0 {}} test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} { expr {[testparser [testbytestring "foo\0zz"] 0] eq "- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}" @@ -707,7 +707,7 @@ test parse-13.6 {Tcl_ParseVar memory leak} -constraints {testparsevar memory} -s } -result 0 test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {testparser testbytestring} { - testparser [testbytestring "foo\0 bar"] -1 + testparser [testbytestring "foo\x00 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser { testparser "foo bar" -1 @@ -744,7 +744,7 @@ test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser { } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"} test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} {testparser testbytestring} { - testparser [testbytestring "foo\0 bar"] -1 + testparser [testbytestring "foo\x00 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} testparser { testparser "foo bar" -1 @@ -910,10 +910,10 @@ test parse-15.54 {CommandComplete procedure} " info complete \"foo bar;# \{\" " 1 test parse-15.55 {CommandComplete procedure} testbytestring { - info complete "set x [testbytestring \0]; puts hi" + info complete "set x [testbytestring \x00]; puts hi" } 1 test parse-15.56 {CommandComplete procedure} testbytestring { - info complete "set x [testbytestring \0]; \{" + info complete "set x [testbytestring \x00]; \{" } 0 test parse-15.57 {CommandComplete procedure} { info complete "# Comment should be complete command" diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 99ada39..c70c5e3 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -32,9 +32,9 @@ proc testIEEE {} { switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian - binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \ ieeeValues(-Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) @@ -44,19 +44,19 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \ ieeeValues(+Normal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \ ieeeValues(+Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { - binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) - binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) @@ -66,11 +66,11 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) - binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) - binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) - binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 @@ -85,7 +85,7 @@ testConstraint ieeeFloatingPoint [testIEEE] ###################################################################### test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {testexprparser testbytestring} { - testexprparser [testbytestring "1+2\0 +3"] -1 + testexprparser [testbytestring "1+2\x00 +3"] -1 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} testexprparser { testexprparser "1 + 2" -1 @@ -882,17 +882,17 @@ test parseExpr-21.36 {error messages} -body { } -returnCodes error -result {invalid character "@" in expression "...fghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstu..."} test parseExpr-21.37 {error messages} -body { - expr [format {"%s" @ 0} [string repeat \u00a7 25]] + expr [format {"%s" @ 0} [string repeat \xA7 25]] } -returnCodes error -result [format {invalid character "@" -in expression "...%s" @ 0"} [string repeat \u00a7 10]] +in expression "...%s" @ 0"} [string repeat \xA7 10]] test parseExpr-21.38 {error messages} -body { - expr [format {0 @ "%s"} [string repeat \u00a7 25]] + expr [format {0 @ "%s"} [string repeat \xA7 25]] } -returnCodes error -result [format {invalid character "@" -in expression "0 @ "%s..."} [string repeat \u00a7 10]] +in expression "0 @ "%s..."} [string repeat \xA7 10]] test parseExpr-21.39 {error messages} -body { - expr [format {"%s" @ "%s"} [string repeat \u00a7 25] [string repeat \u00a7 25]] + expr [format {"%s" @ "%s"} [string repeat \xA7 25] [string repeat \xA7 25]] } -returnCodes error -result [format {invalid character "@" -in expression "...%s" @ "%s..."} [string repeat \u00a7 10] [string repeat \u00a7 10]] +in expression "...%s" @ "%s..."} [string repeat \xA7 10] [string repeat \xA7 10]] test parseExpr-21.40 {error messages} -body { catch {expr {"abcdefghijklmnopqrstuvwxyz"@0}} m o dict get $o -errorinfo @@ -902,13 +902,13 @@ in expression "...fghijklmnopqrstuvwxyz"@0" invoked from within "expr {"abcdefghijklmnopqrstuvwxyz"@0}"} test parseExpr-21.41 {error messages} -body { - catch {expr [format {"%s" @ 0} [string repeat \u00a7 25]]} m o + catch {expr [format {"%s" @ 0} [string repeat \xA7 25]]} m o dict get $o -errorinfo } -result [format {invalid character "@" in expression "...%s" @ 0" (parsing expression ""%s...") invoked from within -"expr [format {"%%s" @ 0} [string repeat \u00a7 25]]"} [string repeat \u00a7 10] [string repeat \u00a7 10]] +"expr [format {"%%s" @ 0} [string repeat \xA7 25]]"} [string repeat \xA7 10] [string repeat \xA7 10]] test parseExpr-21.42 {error message} -body { expr {123456789012345678901234567890*"abcdefghijklmnopqrstuvwxyz} } -returnCodes error -result {missing " @@ -1066,13 +1066,13 @@ test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body { } -result {TCL PARSE EXPR BADNUMBER BINARY} test parseExpr-22.19 {Bug d2ffcca163} -constraints testexprparser -body { - testexprparser \u0433 -1 + testexprparser г -1 } -returnCodes error -match glob -result {*invalid character*} test parseExpr-22.20 {Bug d2ffcca163} -constraints testexprparser -body { - testexprparser \u043f -1 + testexprparser п -1 } -returnCodes error -match glob -result {*invalid character*} test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body { - testexprparser in\u0433(0) -1 + testexprparser inг(0) -1 } -returnCodes error -match glob -result {missing operand*} test parseExpr-23.1 {TIP 582: comments} -constraints testexprparser -body { diff --git a/tests/parseOld.test b/tests/parseOld.test index f8caf24..853f5b5 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -264,14 +264,14 @@ test parseOld-7.10 {backslash substitution} { test parseOld-7.11 {backslash substitution} { eval "list a \"b c\"\\\nd e" } {a {b c} d e} -test parseOld-7.12 {backslash substitution} testbytestring { - expr {[list \ua2] eq [testbytestring "\xc2\xa2"]} +test parseOld-7.12 {backslash substitution} { + expr {[list \uA2] eq "¢"} } 1 -test parseOld-7.13 {backslash substitution} testbytestring { - expr {[list \u4e21] eq [testbytestring "\xe4\xb8\xa1"]} +test parseOld-7.13 {backslash substitution} { + expr {[list \u4E21] eq "両"} } 1 -test parseOld-7.14 {backslash substitution} testbytestring { - expr {[list \u4e2k] eq [testbytestring "\xd3\xa2k"]} +test parseOld-7.14 {backslash substitution} { + expr {[list \u4E2k] eq "Ӣk"} } 1 # Semi-colon. diff --git a/tests/reg.test b/tests/reg.test index 5ebc2f9..b6198d8 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -514,8 +514,8 @@ expectMatch 9.40 eE {a[\\]b} "a\\b" "a\\b" expectMatch 9.41 bE {a[\\]b} "a\\b" "a\\b" expectError 9.42 - {a[\Z]b} EESCAPE expectMatch 9.43 & {a[[b]c} "a\[c" "a\[c" -expectMatch 9.44 EMP* {a[\u00fe-\u0507][\u00ff-\u0300]b} \ - "a\u0102\u02ffb" "a\u0102\u02ffb" +expectMatch 9.44 EMP* {a[\xFE-\u0507][\xFF-\u0300]b} \ + "a\u0102\u02FFb" "a\u0102\u02FFb" doing 10 "anchors and newlines" @@ -643,8 +643,8 @@ expectMatch 13.29 P "a\\U0001234x" "a\u1234x" "a\u1234x" expectMatch 13.30 P {a\U0001234x} "a\u1234x" "a\u1234x" expectMatch 13.31 P "a\\U000012345x" "a\u12345x" "a\u12345x" expectMatch 13.32 P {a\U000012345x} "a\u12345x" "a\u12345x" -expectMatch 13.33 P "a\\U1000000x" "a\ufffd0x" "a\ufffd0x" -expectMatch 13.34 P {a\U1000000x} "a\ufffd0x" "a\ufffd0x" +expectMatch 13.33 P "a\\U1000000x" "a\uFFFD0x" "a\uFFFD0x" +expectMatch 13.34 P {a\U1000000x} "a\uFFFD0x" "a\uFFFD0x" doing 14 "back references" diff --git a/tests/regexp.test b/tests/regexp.test index 842789e..e788b7f 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -54,8 +54,8 @@ test regexp-1.6 {basic regexp operation} { } {0 1} test regexp-1.7 {regexp utf compliance} { # if not UTF-8 aware, result is "0 1" - set foo "\u4e4eb q" - regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar + set foo "乎b q" + regexp "乎b q" "a乎b qw幎N wq" bar list [string compare $foo $bar] [regexp 4 $bar] } {0 0} test regexp-1.8 {regexp ***= metasyntax} { @@ -194,14 +194,14 @@ test regexp-3.7 {getting substrings back from regexp} { } {1 {1 2} {1 1} {-1 -1} {2 2}} test regexp-3.8a {-indices by multi-byte utf-8} { regexp -inline -indices {(\w+)-(\w+)} \ - "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442" + "grüß-привет" } {{0 10} {0 3} {5 10}} test regexp-3.8b {-indices by multi-byte utf-8, from -start position} { list\ [regexp -inline -indices -start 3 {(\w+)-(\w+)} \ - "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] \ + "grüß-привет"] \ [regexp -inline -indices -start 4 {(\w+)-(\w+)} \ - "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] + "grüß-привет"] } {{{3 10} {3 3} {5 10}} {}} test regexp-4.1 {-nocase option to regexp} { @@ -352,8 +352,8 @@ test regexp-7.16 {basic regsub operation} { } {0 {}} test regexp-7.17 {regsub utf compliance} { # if not UTF-8 aware, result is "0 1" - set foo "xyz555ijka\u4e4ebpqr" - regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar + set foo "xyz555ijka乎bpqr" + regsub a乎b xyza乎bijka乎bpqr 555 bar list [string compare $foo $bar] [regexp 4 $bar] } {0 0} test regexp-7.18 {basic regsub replacement} { diff --git a/tests/regexpComp.test b/tests/regexpComp.test index 4dfc2e6..76e708d 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -62,8 +62,8 @@ test regexpComp-1.6 {basic regexp operation} { test regexpComp-1.7 {regexp utf compliance} { # if not UTF-8 aware, result is "0 1" evalInProc { - set foo "\u4e4eb q" - regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar + set foo "乎b q" + regexp "乎b q" "a乎b qw幎N wq" bar list [string compare $foo $bar] [regexp 4 $bar] } } {0 0} @@ -447,8 +447,8 @@ test regexpComp-7.16 {basic regsub operation} { test regexpComp-7.17 {regsub utf compliance} { evalInProc { # if not UTF-8 aware, result is "0 1" - set foo "xyz555ijka\u4e4ebpqr" - regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar + set foo "xyz555ijka乎bpqr" + regsub a乎b xyza乎bijka乎bpqr 555 bar list [string compare $foo $bar] [regexp 4 $bar] } } {0 0} diff --git a/tests/scan.test b/tests/scan.test index c125080..c6e7922 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -32,9 +32,9 @@ proc testIEEE {} { switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian - binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \ ieeeValues(-Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) @@ -44,19 +44,19 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \ ieeeValues(+Normal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \ ieeeValues(+Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \ ieeeValues(NaN) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { - binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) - binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) @@ -66,11 +66,11 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) - binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) - binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) - binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) set ieeeValues(littleEndian) 0 return 1 @@ -639,18 +639,18 @@ test scan-7.5 {string and character scanning} -setup { test scan-7.6 {string and character scanning, unicode} -setup { set a {}; set b {}; set c {}; set d {} } -body { - list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d -} -result "4 abc d\u00c7f ghijk dum" + list [scan "abc dÇfghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d +} -result "4 abc dÇf ghijk dum" test scan-7.7 {string and character scanning, unicode} -setup { set a {}; set b {} } -body { - list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b + list [scan "abÇcdef" "ab%c%c" a b] $a $b } -result "2 199 99" test scan-7.8 {string and character scanning, unicode} -setup { set a {}; set b {} } -body { - list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a -} -result "1 ab\ufeff" + list [scan "ab\uFEFFdef" "%\[ab\uFEFF\]" a] $a +} -result "1 ab\uFEFF" test scan-8.1 {error conditions} -body { scan a diff --git a/tests/source.test b/tests/source.test index 5441b13..c436317 100644 --- a/tests/source.test +++ b/tests/source.test @@ -111,7 +111,7 @@ test source-2.7 {utf-8 with BOM} -setup { } -body { set out [open $sourcefile w] fconfigure $out -encoding utf-8 - puts $out "\ufeffset y new-y" + puts $out "\uFEFFset y new-y" close $out set y old-y source $sourcefile @@ -199,7 +199,7 @@ test source-4.1 {continuation line parsing} -setup { test source-6.1 {source is binary ok} -setup { # Note [makeFile] writes in the system encoding. # [source] defaults to reading in the system encoding. - set sourcefile [makeFile [list set x "a b\0c"] source.file] + set sourcefile [makeFile [list set x "a b\x00c"] source.file] } -body { set x {} source $sourcefile @@ -208,7 +208,7 @@ test source-6.1 {source is binary ok} -setup { removeFile source.file } -result 5 test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup { - set sourcefile [makeFile "set x ab\32c" source.file] + set sourcefile [makeFile "set x ab\x1Ac" source.file] } -body { set x {} source $sourcefile @@ -222,7 +222,7 @@ test source-7.1 {source -encoding test} -setup { file delete $sourcefile set f [open $sourcefile w] fconfigure $f -encoding utf-8 - puts $f "set symbol(square-root) \u221A; set x correct" + puts $f "set symbol(square-root) √; set x correct" close $f } -body { set x unset @@ -233,15 +233,15 @@ test source-7.1 {source -encoding test} -setup { } -result correct test source-7.2 {source -encoding test} -setup { # This tests for bad interactions between [source -encoding] - # and use of the Control-Z character (\u001A) as a cross-platform + # and use of the Control-Z character (\x1A) as a cross-platform # EOF character by [source]. Here we write out and the [source] a - # file that contains the byte \x1A, although not the character \u001A in + # file that contains the byte \x1A, although not the character \x1A in # the indicated encoding. set sourcefile [makeFile {} source.file] file delete $sourcefile set f [open $sourcefile w] fconfigure $f -encoding utf-16 - puts $f "set symbol(square-root) \u221A; set x correct" + puts $f "set symbol(square-root) √; set x correct" close $f } -body { set x unset @@ -266,25 +266,25 @@ test source-7.5 {source -encoding: correct operation} -setup { file delete $sourcefile set f [open $sourcefile w] fconfigure $f -encoding utf-8 - puts $f "proc \u20ac {} {return foo}" + puts $f "proc € {} {return foo}" close $f } -body { source $sourcefile - \u20ac + € } -cleanup { removeFile source.file - rename \u20ac {} + rename € {} } -result foo test source-7.6 {source -encoding: mismatch encoding error} -setup { set sourcefile [makeFile {} source.file] file delete $sourcefile set f [open $sourcefile w] fconfigure $f -encoding utf-8 - puts $f "proc \u20ac {} {return foo}" + puts $f "proc € {} {return foo}" close $f } -body { source -encoding ascii $sourcefile - \u20ac + € } -cleanup { removeFile source.file } -returnCodes error -match glob -result {invalid command name*} diff --git a/tests/split.test b/tests/split.test index 74879cf..a34c49d 100644 --- a/tests/split.test +++ b/tests/split.test @@ -49,20 +49,20 @@ test split-1.8 {basic split commands} { } {]\n} test split-1.9 {basic split commands} { proc foo {} { - set x ab\000c + set x ab\x00c set y [split $x {}] return $y } foo -} "a b \000 c" +} "a b \x00 c" test split-1.10 {basic split commands} { - split "a0ab1b2bbb3\000c4" ab\000c + split "a0ab1b2bbb3\x00c4" ab\x00c } {{} 0 {} 1 2 {} {} 3 {} 4} test split-1.11 {basic split commands} { split "12,3,45" {,} } {12 3 45} test split-1.12 {basic split commands} { - split "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1 + split "\x01ab\x01cd\x01\x01ef\x01" \x01 } {{} ab cd {} ef {}} test split-1.13 {basic split commands} { split "12,34,56," {,} @@ -71,10 +71,10 @@ test split-1.14 {basic split commands} { split ",12,,,34,56," {,} } {{} 12 {} {} 34 56 {}} test split-1.15 {basic split commands} -body { - split "a\U1F4A9b" {} -} -result "a \U1F4A9 b" + split "a💩b" {} +} -result "a 💩 b" test split-1.16 {basic split commands} -body { - split "a\U1F4A9b" \U1F4A9 + split "a💩b" 💩 } -result "a b" test split-2.1 {split errors} { diff --git a/tests/string.test b/tests/string.test index 5952388..440574b 100644 --- a/tests/string.test +++ b/tests/string.test @@ -119,16 +119,16 @@ test string-2.10.$noComp {string compare with special index} { list [catch {run {string compare -length end-3 abcde abxyz}} msg] $msg } {1 {expected integer but got "end-3"}} test string-2.11.$noComp {string compare, unicode} { - run {string compare ab\u7266 ab\u7267} + run {string compare ab牦 ab牧} } -1 test string-2.11.1.$noComp {string compare, unicode} { - run {string compare \334 \xDC} + run {string compare Ü Ü} } 0 test string-2.11.2.$noComp {string compare, unicode} { - run {string compare \334 \xFC} + run {string compare Ü ü} } -1 test string-2.11.3.$noComp {string compare, unicode} { - run {string compare \334\334\334\374\374 \334\334\334\334\334} + run {string compare ÜÜÜüü ÜÜÜÜÜ} } 1 test string-2.12.$noComp {string compare, high bit} { # This test will fail if the underlying comparison @@ -152,10 +152,10 @@ test string-2.15.$noComp {string compare -nocase} { run {string compare -nocase abcde abcde} } 0 test string-2.15.1.$noComp {string compare -nocase} { - run {string compare -nocase \334 \xDC} + run {string compare -nocase Ü Ü} } 0 test string-2.15.2.$noComp {string compare -nocase} { - run {string compare -nocase \334\334\334\374\xFC \334\334\334\334\334} + run {string compare -nocase ÜÜÜüü ÜÜÜÜÜ} } 0 test string-2.16.$noComp {string compare -nocase with length} { run {string compare -length 2 -nocase abcde Abxyz} @@ -172,7 +172,7 @@ test string-2.19.$noComp {string compare -nocase with excessive length} { test string-2.20.$noComp {string compare -len unicode} { # These are strings that are 6 BYTELENGTH long, but the length # shouldn't make a different because there are actually 3 CHARS long - run {string compare -len 5 \334\334\334 \334\334\374} + run {string compare -len 5 ÜÜÜ ÜÜü} } -1 test string-2.21.$noComp {string compare -nocase with special index} { list [catch {run {string compare -nocase -length end-3 Abcde abxyz}} msg] $msg @@ -237,7 +237,7 @@ test string-3.3.$noComp {string equal} { run {string equal abcde abcde} } 1 test string-3.4.$noComp {string equal -nocase} { - run {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334} + run {string equal -nocase ÜÜÜÜüüüü ÜÜÜÜÜÜÜÜ} } 1 test string-3.5.$noComp {string equal -nocase} { run {string equal -nocase abcde abdef} @@ -274,19 +274,19 @@ test string-3.15.$noComp {string equal with special index} { } {1 {expected integer but got "end-3"}} test string-3.16.$noComp {string equal, unicode} { - run {string equal ab\u7266 ab\u7267} + run {string equal ab牦 ab牧} } 0 test string-3.17.$noComp {string equal, unicode} { - run {string equal \334 \xDC} + run {string equal Ü Ü} } 1 test string-3.18.$noComp {string equal, unicode} { - run {string equal \334 \xFC} + run {string equal Ü ü} } 0 test string-3.19.$noComp {string equal, unicode} { - run {string equal \334\334\334\374\374 \334\334\334\334\334} + run {string equal ÜÜÜüü ÜÜÜÜÜ} } 0 test string-3.20.$noComp {string equal, high bit} { - # This test will fail if the underlying comparaison + # This test will fail if the underlying comparison # is using signed chars instead of unsigned chars. # (like SunOS's default memcmp thus the compat/memcmp.c) run {string equal "\x80" "@"} @@ -298,10 +298,10 @@ test string-3.21.$noComp {string equal -nocase} { run {string equal -nocase abcde Abdef} } 0 test string-3.22.$noComp {string equal, -nocase unicode} { - run {string equal -nocase \334 \xDC} + run {string equal -nocase Ü Ü} } 1 test string-3.23.$noComp {string equal, -nocase unicode} { - run {string equal -nocase \334\334\334\374\xFC \334\334\334\334\334} + run {string equal -nocase ÜÜÜüü ÜÜÜÜÜ} } 1 test string-3.24.$noComp {string equal -nocase with length} { run {string equal -length 2 -nocase abcde Abxyz} @@ -318,7 +318,7 @@ test string-3.27.$noComp {string equal -nocase with excessive length} { test string-3.28.$noComp {string equal -len unicode} { # These are strings that are 6 BYTELENGTH long, but the length # shouldn't make a different because there are actually 3 CHARS long - run {string equal -len 5 \334\334\334 \334\334\374} + run {string equal -len 5 ÜÜÜ ÜÜü} } 0 test string-3.29.$noComp {string equal -nocase with special index} { list [catch {run {string equal -nocase -length end-3 Abcde abxyz}} msg] $msg @@ -391,19 +391,19 @@ test string-4.8.$noComp {string first} { run {string first "" x123xx345xxx789xxx012} } -1 test string-4.9.$noComp {string first, unicode} { - run {string first x abc\u7266x} + run {string first x abc牦x} } 4 test string-4.10.$noComp {string first, unicode} { - run {string first \u7266 abc\u7266x} + run {string first 牦 abc牦x} } 3 test string-4.11.$noComp {string first, start index} { - run {string first \u7266 abc\u7266x 3} + run {string first 牦 abc牦x 3} } 3 test string-4.12.$noComp {string first, start index} -body { - run {string first \u7266 abc\u7266x 4} + run {string first 牦 abc牦x 4} } -result -1 test string-4.13.$noComp {string first, start index} -body { - run {string first \u7266 abc\u7266x end-2} + run {string first 牦 abc牦x end-2} } -result 3 test string-4.14.$noComp {string first, negative start index} -body { run {string first b abc -1} @@ -412,7 +412,7 @@ test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded # strings was incorrect, leading to an index returned by [string first] # which pointed past the end of the string. - set uchar \u057E ;# character with two-byte encoding in utf-8 + set uchar վ ;# character with two-byte encoding in utf-8 run {string first % %#$uchar$uchar#$uchar$uchar#% 3} } -result 8 test string-4.16.$noComp {string first, normal string vs pure unicode string} -body { @@ -469,13 +469,13 @@ test string-5.9.$noComp {string index} { run {string index abc end-1} } b test string-5.10.$noComp {string index, unicode} { - run {string index abc\u7266d 4} + run {string index abc牦d 4} } d test string-5.11.$noComp {string index, unicode} { - run {string index abc\u7266d 3} -} \u7266 + run {string index abc牦d 3} +} 牦 test string-5.12.$noComp {string index, unicode over char length, under byte length} -body { - run {string index \334\374\334\374 6} + run {string index ÜüÜü 6} } -result {} test string-5.13.$noComp {string index, bytearray object} { run {string index [binary format a5 fuz] 0} @@ -551,7 +551,7 @@ test string-6.12.$noComp {string is alnum, true} { test string-6.13.$noComp {string is alnum, false} { list [run {string is alnum -failindex var abc1.23}] $var } {0 4} -test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xFC}" 1 +test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abcü}" 1 test string-6.15.$noComp {string is alpha, true} { run {string is alpha abc} } 1 @@ -559,7 +559,7 @@ test string-6.16.$noComp {string is alpha, false} { list [run {string is alpha -fail var a1bcde}] $var } {0 1} test string-6.17.$noComp {string is alpha, unicode} { - run {string is alpha abc\374} + run {string is alpha abcü} } 1 test string-6.18.$noComp {string is ascii, true} { run {string is ascii abc\x7Fend\x00} @@ -583,7 +583,7 @@ test string-6.24.$noComp {string is digit, true} { run {string is digit 0123456789} } 1 test string-6.25.$noComp {string is digit, false} { - list [run {string is digit -fail var 0123\xDC567}] $var + list [run {string is digit -fail var 0123Ü567}] $var } {0 4} test string-6.26.$noComp {string is digit, false} { list [run {string is digit -fail var +123567}] $var @@ -706,7 +706,7 @@ test string-6.60.$noComp {string is lower, true} { run {string is lower abc} } 1 test string-6.61.$noComp {string is lower, unicode true} { - run {string is lower abc\xFCue} + run {string is lower abcüue} } 1 test string-6.62.$noComp {string is lower, false} { list [run {string is lower -fail var aBc}] $var @@ -715,7 +715,7 @@ test string-6.63.$noComp {string is lower, false} { list [run {string is lower -fail var abc1}] $var } {0 3} test string-6.64.$noComp {string is lower, unicode false} { - list [run {string is lower -fail var ab\xDCUE}] $var + list [run {string is lower -fail var abÜUE}] $var } {0 2} test string-6.65.$noComp {string is space, true} { run {string is space " \t\n\v\f"} @@ -753,7 +753,7 @@ test string-6.75.$noComp {string is upper, true} { run {string is upper ABC} } 1 test string-6.76.$noComp {string is upper, unicode true} { - run {string is upper ABC\xDCUE} + run {string is upper ABCÜUE} } 1 test string-6.77.$noComp {string is upper, false} { list [run {string is upper -fail var AbC}] $var @@ -762,13 +762,13 @@ test string-6.78.$noComp {string is upper, false} { list [run {string is upper -fail var AB2C}] $var } {0 2} test string-6.79.$noComp {string is upper, unicode false} { - list [run {string is upper -fail var ABC\xFCue}] $var + list [run {string is upper -fail var ABCüue}] $var } {0 3} test string-6.80.$noComp {string is wordchar, true} { run {string is wordchar abc_123} } 1 test string-6.81.$noComp {string is wordchar, unicode true} { - run {string is wordchar abc\xFCab\xDCAB\u5001\U1D7CA} + run {string is wordchar abcüabÜAB倁\U1D7CA} } 1 test string-6.82.$noComp {string is wordchar, false} { list [run {string is wordchar -fail var abcd.ef}] $var @@ -981,22 +981,22 @@ test string-7.6.$noComp {string last} { run {string las x xxxx123xx345x678} } 12 test string-7.7.$noComp {string last, unicode} { - run {string las x xxxx12\u7266xx345x678} + run {string las x xxxx12牦xx345x678} } 12 test string-7.8.$noComp {string last, unicode} { - run {string las \u7266 xxxx12\u7266xx345x678} + run {string las 牦 xxxx12牦xx345x678} } 6 test string-7.9.$noComp {string last, stop index} { - run {string las \u7266 xxxx12\u7266xx345x678} + run {string las 牦 xxxx12牦xx345x678} } 6 test string-7.10.$noComp {string last, unicode} { - run {string las \u7266 xxxx12\u7266xx345x678} + run {string las 牦 xxxx12牦xx345x678} } 6 test string-7.11.$noComp {string last, start index} { - run {string last \u7266 abc\u7266x 3} + run {string last 牦 abc牦x 3} } 3 test string-7.12.$noComp {string last, start index} { - run {string last \u7266 abc\u7266x 2} + run {string last 牦 abc牦x 2} } -1 test string-7.13.$noComp {string last, start index} { ## Constrain to last 'a' should work @@ -1007,10 +1007,10 @@ test string-7.14.$noComp {string last, start index} { run {string last ba badbad end-2} } 0 test string-7.15.$noComp {string last, start index} { - run {string last \334a \334ad\334ad 0} + run {string last Üa ÜadÜad 0} } -1 test string-7.16.$noComp {string last, start index} { - run {string last \334a \334ad\334ad end-1} + run {string last Üa ÜadÜad end-1} } 3 test string-8.1.$noComp {string bytelength} { @@ -1039,7 +1039,7 @@ test string-9.4.$noComp {string length} { run {string le ""} } 0 test string-9.5.$noComp {string length, unicode} { - run {string le "abcd\u7266"} + run {string le "abcd牦"} } 5 test string-9.6.$noComp {string length, bytearray object} { run {string length [binary format a5 foo]} @@ -1082,11 +1082,11 @@ test string-10.11.$noComp {string map, nulls} { run {string map {\x00 NULL blah \x00nix} {qwerty}} } {qwerty} test string-10.12.$noComp {string map, unicode} { - run {string map [list \374 ue UE \334] "a\374ueUE\000EU"} -} aueue\334\0EU + run {string map [list ü ue UE Ü] "aüueUE\x00EU"} +} aueueÜ\x00EU test string-10.13.$noComp {string map, -nocase unicode} { - run {string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"} -} aue\334\334\0EU + run {string map -nocase [list ü ue UE Ü] "aüueUE\x00EU"} +} aueÜÜ\x00EU test string-10.14.$noComp {string map, -nocase null arguments} { run {string map -nocase {{} abc} foo} } foo @@ -1290,7 +1290,7 @@ test string-11.32.$noComp {string match nocase} { run {string match -n a A} } 1 test string-11.33.$noComp {string match nocase} { - run {string match -nocase a\334 A\374} + run {string match -nocase aÜ Aü} } 1 test string-11.34.$noComp {string match nocase} { run {string match -nocase a*f ABCDEf} @@ -1457,11 +1457,11 @@ test string-12.16.$noComp {string range} { run {string range abcdefghijklmnop end end-1} } {} test string-12.17.$noComp {string range, unicode} { - run {string range ab\u7266cdefghijklmnop 5 5} + run {string range ab牦cdefghijklmnop 5 5} } e test string-12.18.$noComp {string range, unicode} { - run {string range ab\u7266cdefghijklmnop 2 3} -} \u7266c + run {string range ab牦cdefghijklmnop 2 3} +} 牦c test string-12.19.$noComp {string range, bytearray object} { set b [binary format I* {0x50515253 0x52}] set r1 [run {string range $b 1 end-1}] @@ -1544,15 +1544,15 @@ test string-13.11.$noComp {string repeat} { run {string repeat def 1} } def test string-13.12.$noComp {string repeat} { - run {string repeat ab\u7266cd 3} -} ab\u7266cdab\u7266cdab\u7266cd + run {string repeat ab牦cd 3} +} ab牦cdab牦cdab牦cd test string-13.13.$noComp {string repeat} { run {string repeat \x00 3} } \x00\x00\x00 test string-13.14.$noComp {string repeat} { # The string range will ensure us that string repeat gets a unicode string - run {string repeat [run {string range ab\u7266cd 2 3}] 3} -} \u7266c\u7266c\u7266c + run {string repeat [run {string range ab牦cd 2 3}] 3} +} 牦c牦c牦c test string-14.1.$noComp {string replace} { list [catch {run {string replace}} msg] $msg @@ -1846,7 +1846,7 @@ test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is lappend result [string map $m [run {string trimright $b [testbytestring \xA0]}]] lappend result [string map $m [run {string trimright $b \xE8\xA0}]] lappend result [string map $m [run {string trimright $b [testbytestring \xE8\xA0]}]] - lappend result [string map $m [run {string trimright $b \u0000}]] + lappend result [string map $m [run {string trimright $b \x00}]] } [list {*}[lrepeat 4 fooUV] {*}[lrepeat 2 fooU] {*}[lrepeat 2 foo] fooUV] test string-21.1.$noComp {string wordend} -body { diff --git a/tests/stringObj.test b/tests/stringObj.test index c60d685..18c89bb 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -207,19 +207,19 @@ test stringObj-8.1 {DupStringInternalRep procedure} testobj { [teststringobj maxchars 2] [teststringobj get 2] } {5 10 0 abcde 5 5 0 abcde} test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj { - set x abc\u00ef\u00bf\u00aeghi + set x abc\xEF\xBF\xAEghi string length $x set y $x - list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \ + list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \ [set y] [testobj objtype $x] [testobj objtype $y] -} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string" +} "string string abc\xEF\xBF\xAEghi\xAE\xBF\xEF abc\xEF\xBF\xAEghi string string" test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} testobj { - set x abc\u00ef\u00bf\u00aeghi + set x abc\xEF\xBF\xAEghi set y $x string length $x - list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \ + list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \ [set y] [testobj objtype $x] [testobj objtype $y] -} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string" +} "string string abc\xEF\xBF\xAEghi\xAE\xBF\xEF abc\xEF\xBF\xAEghi string string" test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} testobj { set x abcdefghi string length $x @@ -236,31 +236,31 @@ test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} testobj { } {string string abcdefghijkl abcdefghi string string} test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {testobj testdstring} { - set x abc\u00ef\u00bf\u00aeghi + set x abc\xEF\xBF\xAEghi testdstring free - testdstring append \u00ae\u00bf\u00ef -1 + testdstring append \xAE\xBF\xEF -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} "string none abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none" +} "string none abc\xEF\xBF\xAEghi\xAE\xBF\xEF \xAE\xBF\xEF string none" test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj { - set x abc\u00ef\u00bf\u00aeghi + set x abc\xEF\xBF\xAEghi string length $x list [testobj objtype $x] [append x $x] [testobj objtype $x] \ [append x $x] [testobj objtype $x] -} "string abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi string\ -abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi\ +} "string abc\xEF\xBF\xAEghiabc\xEF\xBF\xAEghi string\ +abc\xEF\xBF\xAEghiabc\xEF\xBF\xAEghiabc\xEF\xBF\xAEghiabc\xEF\xBF\xAEghi\ string" test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj testdstring} { set x abcdefghi testdstring free - testdstring append \u00ae\u00bf\u00ef -1 + testdstring append \xAE\xBF\xEF -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} "string none abcdefghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none" +} "string none abcdefghi\xAE\xBF\xEF \xAE\xBF\xEF string none" test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {testobj testdstring} { set x abcdefghi testdstring free @@ -278,14 +278,14 @@ test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj { } {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\ string} test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {testobj testdstring} { - set x abc\u00ef\u00bf\u00aeghi + set x abc\xEF\xBF\xAEghi testdstring free testdstring append jkl -1 set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} "string none abc\u00ef\u00bf\u00aeghijkl jkl string none" +} "string none abc\xEF\xBF\xAEghijkl jkl string none" test stringObj-9.7 {TclAppendObjToObj, integer src & dest} testobj { set x [expr {4 * 5}] set y [expr {4 + 5}] @@ -306,19 +306,19 @@ test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} testobj { [set y] [testobj objtype $x] [testobj objtype $y] } {string int abcdefghi9 9 string int} test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} testobj { - set x abc\u00ef\u00bf\u00aeghi + set x abc\xEF\xBF\xAEghi set y [expr {4 + 5}] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} "string int abc\u00ef\u00bf\u00aeghi9 9 string int" +} "string int abc\xEF\xBF\xAEghi9 9 string int" test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj { # bug 2678, in <=8.2.0, the second obj (the one to append) in # Tcl_AppendObjToObj was not correctly checked to see if it was all one # byte chars, so a unicode string would be added as one byte chars. set x abcdef set len [string length $x] - set y a\u00fcb\u00e5c\u00ef + set y a\xFCb\xE5c\xEF set len [string length $y] append x $y string length $x @@ -327,7 +327,7 @@ test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} tes lappend q [string index $x $i] } set q -} "a b c d e f a \u00fc b \u00e5 c \u00ef" +} "a b c d e f a \xFC b \xE5 c \xEF" test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring} { testdstring free @@ -337,41 +337,30 @@ test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring [testobj objtype $x] [testobj objtype $y] } [list none bcde string string] test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstring} { - # Because this test does not use \uXXXX notation below instead of - # hardcoding the values, it may fail in multibyte locales. However, we - # need to test that the parser produces untyped objects even when there - # are high-ASCII characters in the input (like "ï"). I don't know what - # else to do but inline those characters here. testdstring free - testdstring append "abc\u00ef\u00efdef" -1 + testdstring append "abcïïdef" -1 set x [testdstring get] list [testobj objtype $x] [set y [string range $x 1 end-1]] \ [testobj objtype $x] [testobj objtype $y] -} [list none "bc\u00EF\u00EFde" string string] +} [list none "bcïïde" string string] test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj { - # set x "abcïïdef" - # Use \uXXXX notation below instead of hardcoding the values, otherwise - # the test will fail in multibyte locales. - set x "abc\u00EF\u00EFdef" + set x "abcïïdef" string length $x list [testobj objtype $x] [set y [string range $x 1 end-1]] \ [testobj objtype $x] [testobj objtype $y] -} [list string "bc\u00EF\u00EFde" string string] +} [list string "bcïïde" string string] test stringObj-10.4 {Tcl_GetRange with some mixed width chars} testobj { - # set a "ïa¿b®cï¿d®" - # Use \uXXXX notation below instead of hardcoding the values, otherwise - # the test will fail in multibyte locales. - set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE" + set a "ïa¿b®cï¿d®" set result [list] while {[string length $a] > 0} { set a [string range $a 1 end-1] lappend result $a } set result -} [list a\u00BFb\u00AEc\u00EF\u00BFd \ - \u00BFb\u00AEc\u00EF\u00BF \ - b\u00AEc\u00EF \ - \u00AEc \ +} [list a\xBFb\xAEc\xEF\xBFd \ + \xBFb\xAEc\xEF\xBF \ + b\xAEc\xEF \ + \xAEc \ {}] test stringObj-11.1 {UpdateStringOfString} testobj { @@ -393,15 +382,15 @@ test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} testobj { list [string index $x end] [string index $x end-1] } {i h} test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} testobj { - string index "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" 0 -} "\u00ef" + string index "\xEFa\xBFb\xAEc\xAE\xBFd\xEF" 0 +} "\xEF" test stringObj-12.5 {Tcl_GetUniChar} testobj { - set x "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" + set x "\xEFa\xBFb\xAEc\xAE\xBFd\xEF" list [string index $x 4] [string index $x 0] -} "\u00ae \u00ef" +} "\xAE \xEF" test stringObj-12.6 {Tcl_GetUniChar} testobj { - string index "\u00efa\u00bfb\u00aec\u00ef\u00bfd\u00ae" end -} "\u00ae" + string index "\xEFa\xBFb\xAEc\xEF\xBFd\xAE" end +} "\xAE" test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} testobj { set a "" @@ -415,19 +404,19 @@ test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj { list [string length $a] [string length $a] } {6 6} test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj { - string length "\u00ae" + string length "\xAE" } 1 test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj { # string length "○○" # Use \uXXXX notation below instead of hardcoding the values, otherwise # the test will fail in multibyte locales. - string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE" + string length "\xEF\xBF\xAE\xEF\xBF\xAE" } 6 test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj { # set a "ïa¿b®cï¿d®" # Use \uXXXX notation below instead of hardcoding the values, otherwise # the test will fail in multibyte locales. - set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE" + set a "\xEFa\xBFb\xAEc\xEF\xBFd\xAE" list [string length $a] [string length $a] } {10 10} test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { diff --git a/tests/subst.test b/tests/subst.test index 03a1ce2..da59c3b 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -48,7 +48,7 @@ test subst-3.2 {backslash substitutions with utf chars} { # 'j' is just a char that doesn't mean anything, and \344 is 'ä' # that also doesn't mean anything, but is multi-byte in UTF-8. list [subst \j] [subst \\j] [subst \\344] [subst \\\344] -} "j j \344 \344" +} "j j ä ä" test subst-4.1 {variable substitutions} { set a 44 diff --git a/tests/timer.test b/tests/timer.test index 1ad17ae..52c0b8a 100644 --- a/tests/timer.test +++ b/tests/timer.test @@ -367,7 +367,7 @@ test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup { } } -body { set x "hello world" - after 1 "set x ab\0cd" + after 1 "set x ab\x00cd" after 10 update string length $x @@ -378,7 +378,7 @@ test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NUL} -setup { } } -body { set x "hello world" - after 1 set x ab\0cd + after 1 set x ab\x00cd after 10 update string length $x @@ -389,8 +389,8 @@ test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup } } -body { set x "hello world" - after 1 set x ab\0cd - after cancel "set x ab\0ef" + after 1 set x ab\x00cd + after cancel "set x ab\x00ef" llength [after info] } -cleanup { foreach i [after info] { @@ -403,8 +403,8 @@ test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup } } -body { set x "hello world" - after 1 set x ab\0cd - after cancel set x ab\0ef + after 1 set x ab\x00cd + after cancel set x ab\x00ef llength [after info] } -cleanup { foreach i [after info] { @@ -417,7 +417,7 @@ test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup { } } -body { set x "hello world" - after idle "set x ab\0cd" + after idle "set x ab\x00cd" update string length $x } -result {5} @@ -427,7 +427,7 @@ test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup { } } -body { set x "hello world" - after idle set x ab\0cd + after idle set x ab\x00cd update string length $x } -result {5} @@ -438,7 +438,7 @@ test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NUL} -setup { } -body { set x "hello world" set id junk - set id [after 10 set x ab\0cd] + set id [after 10 set x ab\x00cd] update string length [lindex [lindex [after info $id] 0] 2] } -cleanup { diff --git a/tests/unixInit.test b/tests/unixInit.test index aa3d50a..2ea7d8e 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -126,7 +126,7 @@ test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup { set oldlibrary $env(TCL_LIBRARY) } } -body { - # ((str != NULL) && (str[0] != '\0')) + # ((str != NULL) && (str[0] != '\x00')) set env(TCL_LIBRARY) sparkly lindex [getlibpath] 0 } -cleanup { @@ -158,7 +158,7 @@ test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup { } } -body { # Child process translates env variable from native encoding. - set env(TCL_LIBRARY) "\xa7" + set env(TCL_LIBRARY) "§" lindex [getlibpath] 0 } -cleanup { unset -nocomplain env(TCL_LIBRARY) env(LANG) @@ -166,7 +166,7 @@ test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup { set env(TCL_LIBRARY) $oldlibrary unset oldlibrary } -} -result "\xa7" +} -result "§" test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} { # cannot test } {} diff --git a/tests/utf.test b/tests/utf.test index 05e30c7..88469d7 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -49,7 +49,7 @@ test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { expr {"\xE0" eq [testbytestring \xC3\xA0]} } 1 test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring { - expr {"\u4E4E" eq [testbytestring \xE4\xB9\x8E]} + expr {"乎" eq [testbytestring \xE4\xB9\x8E]} } 1 test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring { expr {[format %c 0x110000] eq [testbytestring \xEF\xBF\xBD]} @@ -57,10 +57,10 @@ test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring { test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring { expr {[format %c -1] eq [testbytestring \xEF\xBF\xBD]} } 1 -test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf Uesc testbytestring} { +test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf testbytestring} { expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]} } 1 -test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {ucs2 Uesc testbytestring} { +test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {Uesc ucs2 testbytestring} { expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]} } 0 test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { @@ -81,7 +81,7 @@ test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4b 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} { +test utf-1.13.1 {Tcl_UniCharToUtf: Invalid surrogate} {fullutf testbytestring} { expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]} } 1 @@ -106,22 +106,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} { +test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} { string length [testbytestring \xF0\x90\x80\x80] } 2 -test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc utf16} { - string length \U010000 +test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 { + string length 𐀀 } 2 -test utf-2.8.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} { - string length \U010000 +test utf-2.8.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} ucs4 { + string length 𐀀 } 1 -test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} { +test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} { string length [testbytestring \xF4\x8F\xBF\xBF] } 2 -test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc utf16} { +test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 { string length \U10FFFF } 2 -test utf-2.9.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} { +test utf-2.9.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} ucs4 { string length \U10FFFF } 1 test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring { @@ -354,7 +354,7 @@ test utf-6.50 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0]G } 1 test utf-6.51 {Tcl_UtfNext} testutfnext { - testutfnext \u8820 + testutfnext 蠠 } 3 test utf-6.52 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0\xD0] @@ -387,22 +387,22 @@ test utf-6.61 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xF8] } 1 test utf-6.62 {Tcl_UtfNext} testutfnext { - testutfnext \u8820G + testutfnext 蠠G } 3 test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} { - testutfnext \u8820[testbytestring \xA0] + testutfnext 蠠[testbytestring \xA0] } 3 test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} { - testutfnext \u8820[testbytestring \xD0] + testutfnext 蠠[testbytestring \xD0] } 3 test utf-6.65 {Tcl_UtfNext} {testutfnext testbytestring} { - testutfnext \u8820[testbytestring \xE8] + testutfnext 蠠[testbytestring \xE8] } 3 test utf-6.66 {Tcl_UtfNext} {testutfnext testbytestring} { - testutfnext \u8820[testbytestring \xF2] + testutfnext 蠠[testbytestring \xF2] } 3 test utf-6.67 {Tcl_UtfNext} {testutfnext testbytestring} { - testutfnext \u8820[testbytestring \xF8] + testutfnext 蠠[testbytestring \xF8] } 3 test utf-6.68 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0]G @@ -565,7 +565,7 @@ test utf-7.6 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8] } 1 test utf-7.6.1 {Tcl_UtfPrev} {testutfprev testbytestring} { - testutfprev A\u8820[testbytestring \xA0] 2 + testutfprev A蠠[testbytestring \xA0] 2 } 1 test utf-7.6.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xF8\xA0\xA0] 2 @@ -619,7 +619,7 @@ test utf-7.11 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0] } 1 test utf-7.11.1 {Tcl_UtfPrev} {testutfprev testbytestring} { - testutfprev A\u8820[testbytestring \xA0] 3 + testutfprev A蠠[testbytestring \xA0] 3 } 1 test utf-7.11.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xE8\xA0\xF8\xA0] 3 @@ -673,13 +673,13 @@ test utf-7.15.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4 } 1 test utf-7.16 {Tcl_UtfPrev} testutfprev { - testutfprev A\u8820 + testutfprev A蠠 } 1 test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} { - testutfprev A\u8820[testbytestring \xA0] 4 + testutfprev A蠠[testbytestring \xA0] 4 } 1 test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} { - testutfprev A\u8820[testbytestring \xF8] 4 + testutfprev A蠠[testbytestring \xF8] 4 } 1 test utf-7.17 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xA0] @@ -709,7 +709,7 @@ test utf-7.20.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF2\xA0\xA0\xA0] } 1 test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring} { - testutfprev A\u8820[testbytestring \xA0] + testutfprev A蠠[testbytestring \xA0] } 4 test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xD0\xA0\xA0\xA0] @@ -805,7 +805,7 @@ test utf-7.47 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} {test testutfprev [testbytestring \xE8\xA0] } 0 test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} testutfprev { - testutfprev \u8820 2 + testutfprev 蠠 2 } 0 test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} { testutfprev [testbytestring \xE8\xA0\x00] 2 @@ -848,14 +848,14 @@ test utf-8.1 {Tcl_UniCharAtIndex: index = 0} { string index abcd 0 } a test utf-8.2 {Tcl_UniCharAtIndex: index = 0} { - string index \u4E4E\u25A 0 -} \u4E4E + string index 乎ɚ 0 +} 乎 test utf-8.3 {Tcl_UniCharAtIndex: index > 0} { string index abcd 2 } c test utf-8.4 {Tcl_UniCharAtIndex: index > 0} { - string index \u4E4E\u25A\xFF\u543 2 -} \xFF + string index 乎ɚÿՃ 2 +} ÿ test utf-8.5.0 {Tcl_UniCharAtIndex: high surrogate} ucs2 { string index \uD842 0 } \uD842 @@ -872,116 +872,116 @@ test utf-8.7.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { string index \uD83D\uDE00G 0 } \uD83D test utf-8.7.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { - string index \uD83D\uDE00G 0 -} \U1F600 + string index 😀G 0 +} 😀 test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 { - string index \uD83D\uDE00G 0 -} \U1F600 + string index 😀G 0 +} 😀 test utf-8.8.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { string index \uD83D\uDE00G 1 } \uDE00 test utf-8.8.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { - string index \uD83D\uDE00G 1 + string index 😀G 1 } G test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 { - string index \uD83D\uDE00G 1 + string index 😀G 1 } {} test utf-8.9.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { string index \uD83D\uDE00G 2 } G test utf-8.9.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { - string index \uD83D\uDE00G 2 + string index 😀G 2 } {} test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 { - string index \uD83D\uDE00G 2 + string index 😀G 2 } G -test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { - string index \U1F600G 0 +test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { + string index 😀G 0 } \uFFFD -test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} { - string index \U1F600G 0 -} \U1F600 -test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} { - string index \U1F600G 0 -} \U1F600 -test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { - string index \U1F600G 1 +test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { + string index 😀G 0 +} 😀 +test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} utf16 { + string index 😀G 0 +} 😀 +test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { + string index 😀G 1 } G -test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} { - string index \U1F600G 1 +test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { + string index 😀G 1 } G -test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} { - string index \U1F600G 1 +test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} utf16 { + string index 😀G 1 } {} -test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { - string index \U1F600G 2 +test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { + string index 😀G 2 } {} -test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} { - string index \U1F600G 2 +test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { + string index 😀G 2 } {} -test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} { - string index \U1F600G 2 +test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} utf16 { + string index 😀G 2 } G test utf-9.1 {Tcl_UtfAtIndex: index = 0} { string range abcd 0 2 } abc test utf-9.2 {Tcl_UtfAtIndex: index > 0} { - string range \u4E4E\u25A\xFF\u543klmnop 1 5 -} \u25A\xFF\u543kl + string range 乎ɚÿՃklmnop 1 5 +} ɚÿՃkl test utf-9.3.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 { string range \uD83D\uDE00G 0 0 } \uD83D test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 { - string range \uD83D\uDE00G 0 0 -} \U1F600 + string range 😀G 0 0 +} 😀 test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 { - string range \uD83D\uDE00G 0 0 -} \U1F600 + string range 😀G 0 0 +} 😀 test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { string range \U1F600G 1 1 } \uDE00 test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 { - string range \U1F600G 1 1 + string range 😀G 1 1 } G test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { - string range \uD83D\uDE00G 1 1 + string range 😀G 1 1 } {} test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { string range \uD83D\uDE00G 2 2 } G test utf-9.5.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 { - string range \uD83D\uDE00G 2 2 + string range 😀G 2 2 } {} test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { - string range \uD83D\uDE00G 2 2 + string range 😀G 2 2 } G -test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs2} { - string range \U1f600G 0 0 +test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 { + string range 😀G 0 0 } \uFFFD -test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs4} { - string range \U1f600G 0 0 -} \U1F600 -test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc utf16} { - string range \U1f600G 0 0 -} \U1F600 -test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} { - string range \U1f600G 1 1 +test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 { + string range 😀G 0 0 +} 😀 +test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 { + string range 😀G 0 0 +} 😀 +test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { + string range 😀G 1 1 } G -test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} { - string range \U1f600G 1 1 +test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 { + string range 😀G 1 1 } G -test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} { - string range \U1f600G 1 1 +test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { + string range 😀G 1 1 } {} -test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} { - string range \U1f600G 2 2 +test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { + string range 😀G 2 2 } {} -test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} { - string range \U1f600G 2 2 +test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 { + string range 😀G 2 2 } {} -test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} { - string range \U1f600G 2 2 +test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { + string range 😀G 2 2 } G test utf-10.1 {Tcl_UtfBackslash: dst == NULL} { @@ -1000,10 +1000,10 @@ test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring { test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring { expr {"\u4E216" eq "[testbytestring \xE4\xB8\xA1]6"} } 1 -test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {Uesc fullutf testbytestring} { +test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {fullutf testbytestring} { expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"} } 1 -test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {Uesc fullutf testbytestring} { +test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {fullutf testbytestring} { expr {"\U10E2165" eq "[testbytestring \xF4\x8E\x88\x96]5"} } 1 @@ -1066,13 +1066,13 @@ bsCheck \U4E21 20001 Uesc bsCheck \U004E21 20001 Uesc bsCheck \U00004E21 20001 Uesc bsCheck \U0000004E21 78 Uesc -bsCheck \U00110000 69632 {Uesc fullutf} -bsCheck \U01100000 69632 {Uesc fullutf} -bsCheck \U11000000 69632 {Uesc fullutf} -bsCheck \U0010FFFF 1114111 {Uesc fullutf} -bsCheck \U010FFFF0 1114111 {Uesc fullutf} -bsCheck \U10FFFF00 1114111 {Uesc fullutf} -bsCheck \UFFFFFFFF 1048575 {Uesc fullutf} +bsCheck \U00110000 69632 fullutf +bsCheck \U01100000 69632 fullutf +bsCheck \U11000000 69632 fullutf +bsCheck \U0010FFFF 1114111 fullutf +bsCheck \U010FFFF0 1114111 fullutf +bsCheck \U10FFFF00 1114111 fullutf +bsCheck \UFFFFFFFF 1048575 fullutf test utf-11.1 {Tcl_UtfToUpper} { string toupper {} @@ -1084,17 +1084,17 @@ test utf-11.3 {Tcl_UtfToUpper} { string toupper \xE3gh } \xC3GH test utf-11.4 {Tcl_UtfToUpper} { - string toupper \u01E3gh -} \u01E2GH + string toupper ǣgh +} ǢGH test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} { - string toupper \u10D0\u1C90 -} \u1C90\u1C90 -test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} {Uesc fullutf} { - string toupper \U10428 -} \U10400 + string toupper აᲐ +} ᲐᲐ +test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} fullutf { + string toupper 𐐨 +} 𐐀 test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf { - string toupper \uD801\uDC28 -} \uD801\uDC00 + string toupper 𐐨 +} 𐐀 test utf-11.8 {Tcl_UtfToUpper low/high surrogate)} { string toupper \uDC24\uD824 } \uDC24\uD824 @@ -1106,23 +1106,23 @@ test utf-12.2 {Tcl_UtfToLower} { string tolower ABC } abc test utf-12.3 {Tcl_UtfToLower} { - string tolower \xC3GH -} \xE3gh + string tolower ÃGH +} ãgh test utf-12.4 {Tcl_UtfToLower} { - string tolower \u01E2GH -} \u01E3gh + string tolower ǢGH +} ǣgh test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} { - string tolower \u10D0\u1C90 -} \u10D0\u10D0 + string tolower აᲐ +} აა test utf-12.6 {Tcl_UtfToLower low/high surrogate)} { string tolower \uDC24\uD824 } \uDC24\uD824 -test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} {Uesc fullutf} { - string tolower \U10400 -} \U10428 +test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} fullutf { + string tolower 𐐀 +} 𐐨 test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf { - string tolower \uD801\uDC00 -} \uD801\uDC28 + string tolower 𐐀 +} 𐐨 test utf-13.1 {Tcl_UtfToTitle} { string totitle {} @@ -1131,26 +1131,26 @@ test utf-13.2 {Tcl_UtfToTitle} { string totitle abc } Abc test utf-13.3 {Tcl_UtfToTitle} { - string totitle \xE3GH -} \xC3gh + string totitle ãGH +} Ãgh test utf-13.4 {Tcl_UtfToTitle} { - string totitle \u01F3AB -} \u01F2ab + string totitle dzAB +} Dzab test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { - string totitle \u10D0\u1C90 -} \u10D0\u1C90 + string totitle აᲐ +} აᲐ test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { - string totitle \u1C90\u10D0 -} \u1C90\u10D0 + string totitle Აა +} Აა test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} { string totitle \uDC24\uD824 } \uDC24\uD824 -test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} {Uesc fullutf} { - string totitle \U10428\U10400 -} \U10400\U10428 +test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} fullutf { + string totitle 𐐨𐐀 +} 𐐀𐐨 test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf { - string totitle \uD801\uDC28\uD801\uDC00 -} \uD801\uDC00\uD801\uDC28 + string totitle 𐐨𐐀 +} 𐐀𐐨 test utf-14.1 {Tcl_UtfNcasecmp} { string compare -nocase a b @@ -1169,8 +1169,8 @@ test utf-15.1 {Tcl_UniCharToUpper, negative delta} { string toupper aA } AA test utf-15.2 {Tcl_UniCharToUpper, positive delta} { - string toupper \u0178\xFF -} \u0178\u0178 + string toupper Ÿÿ +} ŸŸ test utf-15.3 {Tcl_UniCharToUpper, no delta} { string toupper ! } ! @@ -1179,25 +1179,25 @@ test utf-16.1 {Tcl_UniCharToLower, negative delta} { string tolower aA } aa test utf-16.2 {Tcl_UniCharToLower, positive delta} { - string tolower \u0178\xFF\uA78D\u01C5 -} \xFF\xFF\u0265\u01C6 + string tolower ŸÿꞍDž +} ÿÿɥdž test utf-17.1 {Tcl_UniCharToLower, no delta} { string tolower ! } ! test utf-18.1 {Tcl_UniCharToTitle, add one for title} { - string totitle \u01C4 -} \u01C5 + string totitle DŽ +} Dž test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} { - string totitle \u01C6 -} \u01C5 + string totitle dž +} Dž test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} { - string totitle \u017F -} \x53 + string totitle ſ +} S test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} { - string totitle \xFF -} \u0178 + string totitle ÿ +} Ÿ test utf-18.5 {Tcl_UniCharToTitle, no delta} { string totitle ! } ! @@ -1223,23 +1223,23 @@ test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} { test utf-21.1 {TclUniCharIsAlnum} { # this returns 1 with Unicode 7 compliance - string is alnum \u1040\u021F\u0220 + string is alnum ၀ȟȠ } 1 test utf-21.2 {unicode alnum char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - list [regexp {^[[:alnum:]]+$} \u1040\u021F\u0220] [regexp {^\w+$} \u1040\u021F\u0220_\u203F\u2040\u2054\uFE33\uFE34\uFE4D\uFE4E\uFE4F\uFF3F] + list [regexp {^[[:alnum:]]+$} ၀ȟȠ] [regexp {^\w+$} ၀ȟȠ_‿⁀⁔︳︴﹍﹎﹏_] } {1 1} test utf-21.3 {unicode print char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - regexp {^[[:print:]]+$} \uFBC1 + regexp {^[[:print:]]+$} ﯁ } 1 test utf-21.4 {TclUniCharIsGraph} { # [Bug 3464428] - string is graph \u0120 + string is graph Ġ } 1 test utf-21.5 {unicode graph char in regc_locale.c} { # [Bug 3464428] - regexp {^[[:graph:]]+$} \u0120 + regexp {^[[:graph:]]+$} Ġ } 1 test utf-21.6 {TclUniCharIsGraph} { # [Bug 3464428] @@ -1274,25 +1274,25 @@ test utf-22.1 {TclUniCharIsWordChar} { string wordend "xyz123_bar fg" 0 } 10 test utf-22.2 {TclUniCharIsWordChar} { - string wordend "x\u5080z123_bar\u203C fg" 0 + string wordend "x傀z123_bar‼ fg" 0 } 10 test utf-23.1 {TclUniCharIsAlpha} { # this returns 1 with Unicode 7 compliance - string is alpha \u021F\u0220\u037F\u052F + string is alpha ȟȠͿԯ } 1 test utf-23.2 {unicode alpha char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - regexp {^[[:alpha:]]+$} \u021F\u0220\u037F\u052F + regexp {^[[:alpha:]]+$} ȟȠͿԯ } 1 test utf-24.1 {TclUniCharIsDigit} { # this returns 1 with Unicode 7 compliance - string is digit \u1040\uABF0 + string is digit ၀꯰ } 1 test utf-24.2 {unicode digit char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - list [regexp {^[[:digit:]]+$} \u1040\uABF0] [regexp {^\d+$} \u1040\uABF0] + list [regexp {^[[:digit:]]+$} ၀꯰] [regexp {^\d+$} ၀꯰] } {1 1} test utf-24.3 {TclUniCharIsSpace} { @@ -1339,9 +1339,9 @@ UniCharCaseCmpTest > b a UniCharCaseCmpTest > B a UniCharCaseCmpTest > aBcB abca UniCharCaseCmpTest < \uFFFF [format %c 0x10000] ucs4 -UniCharCaseCmpTest < \uFFFF \U10000 {Uesc ucs4} +UniCharCaseCmpTest < \uFFFF \U10000 ucs4 UniCharCaseCmpTest > [format %c 0x10000] \uFFFF ucs4 -UniCharCaseCmpTest > \U10000 \uFFFF {Uesc ucs4} +UniCharCaseCmpTest > \U10000 \uFFFF ucs4 test utf-26.1 {Tcl_UniCharDString} -setup { diff --git a/tests/util.test b/tests/util.test index 52e76ae..385896e 100644 --- a/tests/util.test +++ b/tests/util.test @@ -30,9 +30,9 @@ proc testIEEE {} { switch -exact -- $c { {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { # little endian - binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \ ieeeValues(-Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \ ieeeValues(-Normal) binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ ieeeValues(-Subnormal) @@ -42,23 +42,23 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ ieeeValues(+Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \ ieeeValues(+Normal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \ ieeeValues(+Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \ ieeeValues(NaN) - binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \ + binary scan \x00\x00\x00\x00\x00\x00\xF8\xFF d \ ieeeValues(-NaN) - binary scan \xef\xcd\xab\x89\x67\x45\xfb\xff d \ + binary scan \xEF\xCD\xAB\x89\x67\x45\xFB\xFF d \ ieeeValues(-NaN(3456789abcdef)) set ieeeValues(littleEndian) 1 return 1 } {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { - binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Infinity) - binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Normal) binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-Subnormal) @@ -68,15 +68,15 @@ proc testIEEE {} { ieeeValues(+0) binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Subnormal) - binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Normal) - binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \ ieeeValues(+Infinity) - binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(NaN) - binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \ + binary scan \xFF\xF8\x00\x00\x00\x00\x00\x00 d \ ieeeValues(-NaN) - binary scan \xff\xfb\x45\x67\x89\xab\xcd\xef d \ + binary scan \xFF\xFB\x45\x67\x89\xAB\xCD\xEF d \ ieeeValues(-NaN(3456789abcdef)) set ieeeValues(littleEndian) 0 return 1 @@ -204,9 +204,9 @@ test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} { concat a { } c } {a c} test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} { - # Check for Bug #227512. If this violates C isspace, then it returns \xc3. - concat \xe0 -} \xe0 + # Check for Bug #227512. If this violates C isspace, then it returns \xC3. + concat \xE0 +} \xE0 test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj { # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the # symptoms was Bug #2055782. @@ -236,14 +236,14 @@ test util-5.6 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch *3*6*9 01234567890 } 0 test util-5.7 {Tcl_StringMatch: UTF-8} { - Wrapper_Tcl_StringMatch *u \u4e4fu + Wrapper_Tcl_StringMatch *u 乏u } 1 test util-5.8 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch a?c abc } 1 test util-5.9 {Tcl_StringMatch: UTF-8} { # skip one character in string - Wrapper_Tcl_StringMatch a?c a\u4e4fc + Wrapper_Tcl_StringMatch a?c a乏c } 1 test util-5.10 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch a??c abc @@ -256,15 +256,15 @@ test util-5.12 {Tcl_StringMatch} { } 1 test util-5.13 {Tcl_StringMatch: UTF-8} { # string += Tcl_UtfToUniChar(string, &ch); - Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc" + Wrapper_Tcl_StringMatch "\[乏xy\]bc" "乏bc" } 1 test util-5.14 {Tcl_StringMatch} { - # if ((*pattern == ']') || (*pattern == '\0')) + # if ((*pattern == ']') || (*pattern == '\x00')) # badly formed pattern Wrapper_Tcl_StringMatch {[]} {[]} } 0 test util-5.15 {Tcl_StringMatch} { - # if ((*pattern == ']') || (*pattern == '\0')) + # if ((*pattern == ']') || (*pattern == '\x00')) # badly formed pattern Wrapper_Tcl_StringMatch {[} {[} } 0 @@ -274,17 +274,17 @@ test util-5.16 {Tcl_StringMatch} { test util-5.17 {Tcl_StringMatch: UTF-8} { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # get 1 UTF-8 character - Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc" + Wrapper_Tcl_StringMatch "a\[a乏c]c" "a乏c" } 1 test util-5.18 {Tcl_StringMatch: UTF-8} testbytestring { # pattern += Tcl_UtfToUniChar(pattern, &endChar); - # proper advance: wrong answer would match on UTF trail byte of \u4e4f - Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\x8Fc] + # proper advance: wrong answer would match on UTF trail byte of 乏 + Wrapper_Tcl_StringMatch {a[a乏c]c} [testbytestring a\x8Fc] } 0 test util-5.19 {Tcl_StringMatch: UTF-8} { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # proper advance. - Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc" + Wrapper_Tcl_StringMatch {a[a乏c]c} "acc" } 1 test util-5.20 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {a[xyz]c} abc @@ -293,13 +293,13 @@ test util-5.21 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {12[2-7]45} 12345 } 1 test util-5.22 {Tcl_StringMatch: UTF-8 range} { - Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "0" + Wrapper_Tcl_StringMatch "\[一-乏]" "0" } 0 test util-5.23 {Tcl_StringMatch: UTF-8 range} { - Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33" + Wrapper_Tcl_StringMatch "\[一-乏]" "丳" } 1 test util-5.24 {Tcl_StringMatch: UTF-8 range} { - Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08" + Wrapper_Tcl_StringMatch "\[一-乏]" "(" } 0 test util-5.25 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12345 @@ -353,16 +353,16 @@ test util-5.41 {Tcl_StringMatch: skip correct number of ']'} { Wrapper_Tcl_StringMatch {[A-]]x} Ax } 1 test util-5.42 {Tcl_StringMatch: skip correct number of ']'} { - Wrapper_Tcl_StringMatch {[A-]]x} \ue1x + Wrapper_Tcl_StringMatch {[A-]]x} \xE1x } 0 test util-5.43 {Tcl_StringMatch: skip correct number of ']'} { - Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x + Wrapper_Tcl_StringMatch \[A-]\xE1]x \xE1x } 1 test util-5.44 {Tcl_StringMatch: skip correct number of ']'} { Wrapper_Tcl_StringMatch {[A-]h]x} hx } 1 test util-5.45 {Tcl_StringMatch} { - # if (*pattern == '\0') + # if (*pattern == '\x00') # badly formed pattern, still treats as a set Wrapper_Tcl_StringMatch {[a} a } 1 @@ -385,7 +385,7 @@ test util-5.51 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch "" "" } 1 test util-5.52 {Tcl_StringMatch} { - Wrapper_Tcl_StringMatch \[a\u0000 a\x80 + Wrapper_Tcl_StringMatch \[a\x00 a\x80 } 0 @@ -404,27 +404,27 @@ test util-8.1 {TclNeedSpace - correct utf-8 handling} { # which calls on TclNeedSpace(). If [interp target] # is ever updated, this test will no longer test # TclNeedSpace. - interp create \u5420 - interp create [list \u5420 foo] - interp alias {} fooset [list \u5420 foo] set + interp create 吠 + interp create [list 吠 foo] + interp alias {} fooset [list 吠 foo] set set result [interp target {} fooset] - interp delete \u5420 + interp delete 吠 set result -} "\u5420 foo" +} "吠 foo" test util-8.2 {TclNeedSpace - correct utf-8 handling} testdstring { # Bug 411825 # This tests the same bug as the previous test, but # should be more future-proof, as the DString # operations will likely continue to call TclNeedSpace testdstring free - testdstring append \u5420 -1 + testdstring append 吠 -1 testdstring element foo llength [testdstring get] } 2 test util-8.3 {TclNeedSpace - correct utf-8 handling} testdstring { # Bug 411825 - new variant reported by Dossy Shiobara testdstring free - testdstring append \u00A0 -1 + testdstring append \xA0 -1 testdstring element foo llength [testdstring get] } 2 diff --git a/tests/var.test b/tests/var.test index 1eaefc5..defd743 100644 --- a/tests/var.test +++ b/tests/var.test @@ -203,27 +203,27 @@ test var-1.19 {TclLookupVar, right error message when parsing variable name} -bo [format set] thisvar(doesntexist) } -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable} test var-1.20 {TclLookupVar, regression on utf-8 variable names} -setup { - proc p [list \u20ac \xe4] {info vars} + proc p [list € ä] {info vars} } -body { # test variable with non-ascii name is available (euro and a-uml chars here): list \ [p 1 2] \ - [apply [list [list \u20ac \xe4] {info vars}] 1 2] \ - [apply [list [list [list \u20ac \u20ac] [list \xe4 \xe4]] {info vars}]] \ + [apply [list [list € ä] {info vars}] 1 2] \ + [apply [list [list [list € €] [list ä ä]] {info vars}]] \ } -cleanup { rename p {} -} -result [lrepeat 3 [list \u20ac \xe4]] +} -result [lrepeat 3 [list € ä]] test var-1.21 {TclLookupVar, regression on utf-8 variable names} -setup { - proc p [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]} + proc p [list [list € v€] [list ä vä]] {list [set €] [set ä]} } -body { # test variable with non-ascii name (and default) is resolvable (euro and a-uml chars here): list \ [p] \ - [apply [list [list \u20ac \xe4] {list [set \u20ac] [set \xe4]}] v\u20ac v\xe4] \ - [apply [list [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]}]] \ + [apply [list [list € ä] {list [set €] [set ä]}] v€ vä] \ + [apply [list [list [list € v€] [list ä vä]] {list [set €] [set ä]}]] \ } -cleanup { rename p {} -} -result [lrepeat 3 [list v\u20ac v\xe4]] +} -result [lrepeat 3 [list v€ vä]] test var-2.1 {Tcl_LappendObjCmd, create var if new} { catch {unset x} diff --git a/tests/winPipe.test b/tests/winPipe.test index 6252f96..28d4f5b 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -174,7 +174,7 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \ {win exec cat32} { set f [open "|[list $cat32]" r+] puts $f $big - puts $f \032 + puts $f \x1A flush $f set r [read $f 64] catch {close $f} diff --git a/tests/zipfs.test b/tests/zipfs.test index 40655b4..bf9c969 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -272,7 +272,7 @@ test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup { } -result {not allowed to invoke subcommand mkzip of zipfs} test zipfs-4.1 {zipfs lmkimg} -constraints zipfs -setup { - set baseImage [makeFile "return sourceWorking\n\x1a" base] + set baseImage [makeFile "return sourceWorking\n\x1A" base] set targetImage [makeFile "" target] set addFile [makeFile "return mountWorking" add.data] file delete $targetImage @@ -290,7 +290,7 @@ test zipfs-4.1 {zipfs lmkimg} -constraints zipfs -setup { removeFile $addFile } -result {sourceWorking mountWorking} test zipfs-4.2 {zipfs lmkimg: making an image from an image} -constraints zipfs -setup { - set baseImage [makeFile "return sourceWorking\n\x1a" base_image.tcl] + set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl] set midImage [makeFile "" mid_image.tcl] set targetImage [makeFile "" target_image.tcl] set addFile [makeFile "return mountWorking" add.data] @@ -316,7 +316,7 @@ test zipfs-4.2 {zipfs lmkimg: making an image from an image} -constraints zipfs removeFile $addFile } -result {ok.tcl equal} test zipfs-4.3 {zipfs lmkimg: stripping password} -constraints zipfs -setup { - set baseImage [makeFile "return sourceWorking\n\x1a" base_image.tcl] + set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl] set midImage [makeFile "" mid_image.tcl] set targetImage [makeFile "" target_image.tcl] set addFile [makeFile "return mountWorking" add.data] @@ -338,7 +338,7 @@ test zipfs-4.3 {zipfs lmkimg: stripping password} -constraints zipfs -setup { removeFile $addFile } -result {ok.tcl} test zipfs-4.4 {zipfs lmkimg: final password} -constraints zipfs -setup { - set baseImage [makeFile "return sourceWorking\n\x1a" base_image.tcl] + set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl] set midImage [makeFile "" mid_image.tcl] set targetImage [makeFile "" target_image.tcl] set addFile [makeFile "return mountWorking" add.data] @@ -360,7 +360,7 @@ test zipfs-4.4 {zipfs lmkimg: final password} -constraints zipfs -setup { removeFile $addFile } -result {ok.tcl} test zipfs-4.5 {zipfs lmkimg: making image from mounted} -constraints zipfs -setup { - set baseImage [makeFile "return sourceWorking\n\x1a" base_image.tcl] + set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl] set midImage [makeFile "" mid_image.tcl] set targetImage [makeFile "" target_image.tcl] set addFile [makeFile "return mountWorking" add.data] diff --git a/unix/Makefile.in b/unix/Makefile.in index 9426ce8..ba748f2 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -671,7 +671,8 @@ UNIX_SRCS = \ NOTIFY_SRCS = \ $(UNIX_DIR)/tclEpollNotfy.c \ $(UNIX_DIR)/tclKqueueNotfy.c \ - $(UNIX_DIR)/tclSelectNotfy.c + $(UNIX_DIR)/tclSelectNotfy.c \ + $(UNIX_DIR)/tclUnixNotfy.c DL_SRCS = \ $(UNIX_DIR)/tclLoadAix.c \ @@ -1772,13 +1773,13 @@ tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c $(FSHDR) $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c -tclEpollNotfy.o: $(UNIX_DIR)/tclEpollNotfy.c +tclEpollNotfy.o: $(UNIX_DIR)/tclEpollNotfy.c $(UNIX_DIR)/tclUnixNotfy.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclEpollNotfy.c -tclKqueueNotfy.o: $(UNIX_DIR)/tclKqueueNotfy.c +tclKqueueNotfy.o: $(UNIX_DIR)/tclKqueueNotfy.c $(UNIX_DIR)/tclUnixNotfy.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclKqueueNotfy.c -tclSelectNotfy.o: $(UNIX_DIR)/tclSelectNotfy.c +tclSelectNotfy.o: $(UNIX_DIR)/tclSelectNotfy.c $(UNIX_DIR)/tclUnixNotfy.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclSelectNotfy.c tclUnixPipe.o: $(UNIX_DIR)/tclUnixPipe.c diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c index 18abacd..a6a183b 100644 --- a/unix/tclEpollNotfy.c +++ b/unix/tclEpollNotfy.c @@ -97,7 +97,7 @@ typedef struct ThreadSpecificData { * that are ready for I/O. */ pthread_mutex_t notifierMutex; /* Mutex protecting notifier termination in - * PlatformEventsFinalize. */ + * TclpFinalizeNotifier. */ #ifdef HAVE_EVENTFD int triggerEventFd; /* eventfd(2) used by other threads to wake * up this thread for inter-thread IPC. */ @@ -121,14 +121,13 @@ static Tcl_ThreadDataKey dataKey; static void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew); -static void PlatformEventsFinalize(void); static void PlatformEventsInit(void); static int PlatformEventsTranslate(struct epoll_event *event); static int PlatformEventsWait(struct epoll_event *events, size_t numEvents, struct timeval *timePtr); - + /* - * Incorporate the base notifier API. + * Incorporate the base notifier implementation. */ #include "tclUnixNotfy.c" @@ -136,7 +135,7 @@ static int PlatformEventsWait(struct epoll_event *events, /* *---------------------------------------------------------------------- * - * Tcl_InitNotifier -- + * TclpInitNotifier -- * * Initializes the platform specific notifier state. * @@ -144,54 +143,21 @@ static int PlatformEventsWait(struct epoll_event *events, * Returns a handle to the notifier state for this thread. * * Side effects: - * If no initNotifierProc notifier hook exists, PlatformEventsInit - * is called. + * If no initNotifierProc notifier hook exists, PlatformEventsInit is + * called. * *---------------------------------------------------------------------- */ ClientData -Tcl_InitNotifier(void) +TclpInitNotifier(void) { - if (tclNotifierHooks.initNotifierProc) { - return tclNotifierHooks.initNotifierProc(); - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - PlatformEventsInit(); - return tsdPtr; - } + PlatformEventsInit(); + return tsdPtr; } -/* - *---------------------------------------------------------------------- - * - * Tcl_FinalizeNotifier -- - * - * This function is called to cleanup the notifier state before a thread - * is terminated. - * - * Results: - * None. - * - * Side effects: - * If no finalizeNotifierProc notifier hook exists, PlatformEvents- - * Finalize is called. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_FinalizeNotifier( - ClientData clientData) -{ - if (tclNotifierHooks.finalizeNotifierProc) { - tclNotifierHooks.finalizeNotifierProc(clientData); - return; - } else { - PlatformEventsFinalize(); - } -} /* *---------------------------------------------------------------------- @@ -221,7 +187,7 @@ Tcl_FinalizeNotifier( *---------------------------------------------------------------------- */ -void +static void PlatformEventsControl( FileHandler *filePtr, ThreadSpecificData *tsdPtr, @@ -240,7 +206,8 @@ PlatformEventsControl( newEvent.events |= EPOLLOUT; } if (isNew) { - newPedPtr = (struct PlatformEventData *)Tcl_Alloc(sizeof(struct PlatformEventData)); + newPedPtr = (struct PlatformEventData *) + Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; @@ -249,7 +216,7 @@ PlatformEventsControl( /* * N.B. As discussed in Tcl_WaitForEvent(), epoll(7) does not support - * regular files (S_IFREG.) Therefore, filePtr is in these cases simply + * regular files (S_IFREG). Therefore, filePtr is in these cases simply * added or deleted from the list of FileHandlers associated with regular * files belonging to tsdPtr. */ @@ -277,7 +244,7 @@ PlatformEventsControl( /* *---------------------------------------------------------------------- * - * PlatformEventsFinalize -- + * TclpFinalizeNotifier -- * * This function closes the eventfd and the epoll file descriptor and * frees the epoll_event structs owned by the thread of the caller. The @@ -299,8 +266,8 @@ PlatformEventsControl( */ void -PlatformEventsFinalize( - void) +TclpFinalizeNotifier( + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -362,7 +329,7 @@ PlatformEventsFinalize( *---------------------------------------------------------------------- */ -void +static void PlatformEventsInit(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -372,7 +339,7 @@ PlatformEventsInit(void) if (errno) { Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex"); } - filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); #ifdef HAVE_EVENTFD tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK); if (tsdPtr->triggerEventFd <= 0) { @@ -393,7 +360,7 @@ PlatformEventsInit(void) PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1); if (!tsdPtr->readyEvents) { tsdPtr->maxReadyEvents = 512; - tsdPtr->readyEvents = (struct epoll_event *)Tcl_Alloc( + tsdPtr->readyEvents = (struct epoll_event *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); @@ -416,7 +383,7 @@ PlatformEventsInit(void) *---------------------------------------------------------------------- */ -int +static int PlatformEventsTranslate( struct epoll_event *eventPtr) { @@ -457,7 +424,7 @@ PlatformEventsTranslate( *---------------------------------------------------------------------- */ -int +static int PlatformEventsWait( struct epoll_event *events, size_t numEvents, @@ -480,9 +447,9 @@ PlatformEventsWait( } else if (!timePtr->tv_sec && !timePtr->tv_usec) { timeout = 0; } else { - timeout = (int)timePtr->tv_sec * 1000; + timeout = (int) timePtr->tv_sec * 1000; if (timePtr->tv_usec) { - timeout += (int)timePtr->tv_usec / 1000; + timeout += (int) timePtr->tv_usec / 1000; } } @@ -493,7 +460,7 @@ PlatformEventsWait( */ gettimeofday(&tv0, NULL); - numFound = epoll_wait(tsdPtr->eventsFd, events, (int)numEvents, timeout); + numFound = epoll_wait(tsdPtr->eventsFd, events, (int) numEvents, timeout); gettimeofday(&tv1, NULL); if (timePtr && (timePtr->tv_sec && timePtr->tv_usec)) { timersub(&tv1, &tv0, &tv_delta); @@ -510,7 +477,7 @@ PlatformEventsWait( /* *---------------------------------------------------------------------- * - * Tcl_CreateFileHandler -- + * TclpCreateFileHandler -- * * This function registers a file handler with the epoll notifier of the * thread of the caller. @@ -526,7 +493,7 @@ PlatformEventsWait( */ void -Tcl_CreateFileHandler( +TclpCreateFileHandler( int fd, /* Handle of stream to watch. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates @@ -536,44 +503,29 @@ Tcl_CreateFileHandler( * event. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { - int isNew; - - if (tclNotifierHooks.createFileHandlerProc) { - tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); - return; - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - FileHandler *filePtr; - - for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { - if (filePtr->fd == fd) { - break; - } - } - if (filePtr == NULL) { - filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); - filePtr->fd = fd; - filePtr->readyMask = 0; - filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; - tsdPtr->firstFileHandlerPtr = filePtr; - isNew = 1; - } else { - isNew = 0; - } - filePtr->proc = proc; - filePtr->clientData = clientData; - filePtr->mask = mask; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); + int isNew = (filePtr == NULL); - PlatformEventsControl(filePtr, tsdPtr, - isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew); + if (isNew) { + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); + filePtr->fd = fd; + filePtr->readyMask = 0; + filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; + tsdPtr->firstFileHandlerPtr = filePtr; } + filePtr->proc = proc; + filePtr->clientData = clientData; + filePtr->mask = mask; + + PlatformEventsControl(filePtr, tsdPtr, + isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew); } /* *---------------------------------------------------------------------- * - * Tcl_DeleteFileHandler -- + * TclpDeleteFileHandler -- * * Cancel a previously-arranged callback arrangement for a file on the * epoll file descriptor of the thread of the caller. @@ -591,60 +543,50 @@ Tcl_CreateFileHandler( */ void -Tcl_DeleteFileHandler( +TclpDeleteFileHandler( int fd) /* Stream id for which to remove callback * function. */ { - if (tclNotifierHooks.deleteFileHandlerProc) { - tclNotifierHooks.deleteFileHandlerProc(fd); - return; - } else { - FileHandler *filePtr, *prevPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + FileHandler *filePtr, *prevPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - /* - * Find the entry for the given file (and return if there isn't one). - */ + /* + * Find the entry for the given file (and return if there isn't one). + */ - for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; - prevPtr = filePtr, filePtr = filePtr->nextPtr) { - if (filePtr == NULL) { - return; - } - if (filePtr->fd == fd) { - break; - } - } + filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr); + if (filePtr == NULL) { + return; + } - /* - * Update the check masks for this file. - */ + /* + * Update the check masks for this file. + */ - PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0); - if (filePtr->pedPtr) { - Tcl_Free(filePtr->pedPtr); - } + PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0); + if (filePtr->pedPtr) { + Tcl_Free(filePtr->pedPtr); + } - /* - * Clean up information in the callback record. - */ + /* + * Clean up information in the callback record. + */ - if (prevPtr == NULL) { - tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; - } else { - prevPtr->nextPtr = filePtr->nextPtr; - } - Tcl_Free(filePtr); + if (prevPtr == NULL) { + tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; + } else { + prevPtr->nextPtr = filePtr->nextPtr; } + Tcl_Free(filePtr); } /* *---------------------------------------------------------------------- * - * Tcl_WaitForEvent -- + * TclpWaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on - * the message queue. If the block time is 0, then Tcl_WaitForEvent just + * the message queue. If the block time is 0, then TclpWaitForEvent just * polls without blocking. * * The waiting logic is implemented in PlatformEventsWait. @@ -660,172 +602,165 @@ Tcl_DeleteFileHandler( */ int -Tcl_WaitForEvent( +TclpWaitForEvent( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - if (tclNotifierHooks.waitForEventProc) { - return tclNotifierHooks.waitForEventProc(timePtr); - } else { - FileHandler *filePtr; - int mask; - Tcl_Time vTime; - /* - * Impl. notes: timeout & timeoutPtr are used if, and only if threads - * are not enabled. They are the arguments for the regular epoll_wait() - * used when the core is not thread-enabled. - */ + FileHandler *filePtr; + Tcl_Time vTime; + struct timeval timeout, *timeoutPtr; + /* Impl. notes: timeout & timeoutPtr are used + * if, and only if threads are not enabled. + * They are the arguments for the regular + * epoll_wait() used when the core is not + * thread-enabled. */ + int mask, numFound, numEvent; + struct PlatformEventData *pedPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int numQueued; + ssize_t i; - struct timeval timeout, *timeoutPtr; - int numFound, numEvent; - struct PlatformEventData *pedPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - int numQueued; - ssize_t i; + /* + * Set up the timeout structure. Note that if there are no events to check + * for, we return with a negative result rather than blocking forever. + */ + if (timePtr != NULL) { /* - * Set up the timeout structure. Note that if there are no events to - * check for, we return with a negative result rather than blocking - * forever. + * TIP #233 (Virtualized Time). Is virtual time in effect? And do we + * actually have something to scale? If yes to both then we call the + * handler to do this scaling. */ - if (timePtr != NULL) { - /* - * TIP #233 (Virtualized Time). Is virtual time in effect? And do - * we actually have something to scale? If yes to both then we - * call the handler to do this scaling. - */ - - if (timePtr->sec != 0 || timePtr->usec != 0) { - vTime = *timePtr; - tclScaleTimeProcPtr(&vTime, tclTimeClientData); - timePtr = &vTime; - } - timeout.tv_sec = timePtr->sec; - timeout.tv_usec = timePtr->usec; - timeoutPtr = &timeout; - } else { - timeoutPtr = NULL; + if (timePtr->sec != 0 || timePtr->usec != 0) { + vTime = *timePtr; + TclScaleTime(&vTime); + timePtr = &vTime; } + timeout.tv_sec = timePtr->sec; + timeout.tv_usec = timePtr->usec; + timeoutPtr = &timeout; + } else { + timeoutPtr = NULL; + } - /* - * Walk the list of FileHandlers associated with regular files - * (S_IFREG) belonging to tsdPtr, queue Tcl events for them, and - * update their mask of events of interest. - * - * As epoll(7) does not support regular files, the behaviour of - * {select,poll}(2) is simply simulated here: fds associated with - * regular files are added to this list by PlatformEventsControl() and - * processed here before calling (and possibly blocking) on - * PlatformEventsWait(). - */ - - numQueued = 0; - LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) { - mask = 0; - if (filePtr->mask & TCL_READABLE) { - mask |= TCL_READABLE; - } - if (filePtr->mask & TCL_WRITABLE) { - mask |= TCL_WRITABLE; - } - - /* - * Don't bother to queue an event if the mask was previously - * non-zero since an event must still be on the queue. - */ - - if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - Tcl_Alloc(sizeof(FileHandlerEvent)); + /* + * Walk the list of FileHandlers associated with regular files (S_IFREG) + * belonging to tsdPtr, queue Tcl events for them, and update their mask + * of events of interest. + * + * As epoll(7) does not support regular files, the behaviour of + * {select,poll}(2) is simply simulated here: fds associated with regular + * files are added to this list by PlatformEventsControl() and processed + * here before calling (and possibly blocking) on PlatformEventsWait(). + */ - fileEvPtr->header.proc = FileHandlerEventProc; - fileEvPtr->fd = filePtr->fd; - Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); - numQueued++; - } - filePtr->readyMask = mask; + numQueued = 0; + LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) { + mask = 0; + if (filePtr->mask & TCL_READABLE) { + mask |= TCL_READABLE; + } + if (filePtr->mask & TCL_WRITABLE) { + mask |= TCL_WRITABLE; } /* - * If any events were queued in the above loop, force - * PlatformEventsWait() to poll as there already are events that need - * to be processed at this point. + * Don't bother to queue an event if the mask was previously non-zero + * since an event must still be on the queue. */ - if (numQueued) { - timeout.tv_sec = 0; - timeout.tv_usec = 0; - timeoutPtr = &timeout; + if (filePtr->readyMask == 0) { + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + Tcl_Alloc(sizeof(FileHandlerEvent)); + + fileEvPtr->header.proc = FileHandlerEventProc; + fileEvPtr->fd = filePtr->fd; + Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); + numQueued++; } + filePtr->readyMask = mask; + } - /* - * Wait or poll for new events, queue Tcl events for the FileHandlers - * corresponding to them, and update the FileHandlers' mask of events - * of interest registered by the last call to Tcl_CreateFileHandler(). - * - * Events for the eventfd(2)/trigger pipe are processed here in order - * to facilitate inter-thread IPC. If another thread intends to wake - * up this thread whilst it's blocking on PlatformEventsWait(), it - * write(2)s to the eventfd(2)/trigger pipe (see Tcl_AlertNotifier(),) - * which in turn will cause PlatformEventsWait() to return - * immediately. - */ + /* + * If any events were queued in the above loop, force PlatformEventsWait() + * to poll as there already are events that need to be processed at this + * point. + */ + + if (numQueued) { + timeout.tv_sec = 0; + timeout.tv_usec = 0; + timeoutPtr = &timeout; + } + + /* + * Wait or poll for new events, queue Tcl events for the FileHandlers + * corresponding to them, and update the FileHandlers' mask of events of + * interest registered by the last call to Tcl_CreateFileHandler(). + * + * Events for the eventfd(2)/trigger pipe are processed here in order to + * facilitate inter-thread IPC. If another thread intends to wake up this + * thread whilst it's blocking on PlatformEventsWait(), it write(2)s to + * the eventfd(2)/trigger pipe (see Tcl_AlertNotifier(),) which in turn + * will cause PlatformEventsWait() to return immediately. + */ - numFound = PlatformEventsWait(tsdPtr->readyEvents, - tsdPtr->maxReadyEvents, timeoutPtr); - for (numEvent = 0; numEvent < numFound; numEvent++) { - pedPtr = (struct PlatformEventData*)tsdPtr->readyEvents[numEvent].data.ptr; - filePtr = pedPtr->filePtr; - mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]); + numFound = PlatformEventsWait(tsdPtr->readyEvents, + tsdPtr->maxReadyEvents, timeoutPtr); + for (numEvent = 0; numEvent < numFound; numEvent++) { + pedPtr = (struct PlatformEventData *) + tsdPtr->readyEvents[numEvent].data.ptr; + filePtr = pedPtr->filePtr; + mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]); #ifdef HAVE_EVENTFD - if (filePtr->fd == tsdPtr->triggerEventFd) { - uint64_t eventFdVal; - i = read(tsdPtr->triggerEventFd, &eventFdVal, - sizeof(eventFdVal)); - if ((i != sizeof(eventFdVal)) && (errno != EAGAIN)) { - Tcl_Panic( - "Tcl_WaitForEvent: read from %p->triggerEventFd: %s", - (void *) tsdPtr, strerror(errno)); - } - continue; + if (filePtr->fd == tsdPtr->triggerEventFd) { + uint64_t eventFdVal; + + i = read(tsdPtr->triggerEventFd, &eventFdVal, sizeof(eventFdVal)); + if ((i != sizeof(eventFdVal)) && (errno != EAGAIN)) { + Tcl_Panic("%s: read from %p->triggerEventFd: %s", + "Tcl_WaitForEvent", (void *) tsdPtr, strerror(errno)); } + continue; + } #else /* !HAVE_EVENTFD */ - if (filePtr->fd == tsdPtr->triggerPipe[0]) { - char triggerPipeVal; - i = read(tsdPtr->triggerPipe[0], &triggerPipeVal, - sizeof(triggerPipeVal)); - if ((i != sizeof(triggerPipeVal)) && (errno != EAGAIN)) { - Tcl_Panic( - "Tcl_WaitForEvent: read from %p->triggerPipe[0]: %s", - (void *) tsdPtr, strerror(errno)); - } - continue; + if (filePtr->fd == tsdPtr->triggerPipe[0]) { + char triggerPipeVal; + + i = read(tsdPtr->triggerPipe[0], &triggerPipeVal, + sizeof(triggerPipeVal)); + if ((i != sizeof(triggerPipeVal)) && (errno != EAGAIN)) { + Tcl_Panic("%s: read from %p->triggerPipe[0]: %s", + "Tcl_WaitForEvent", (void *) tsdPtr, strerror(errno)); } + continue; + } #endif /* HAVE_EVENTFD */ - if (!mask) { - continue; - } + if (!mask) { + continue; + } - /* - * Don't bother to queue an event if the mask was previously - * non-zero since an event must still be on the queue. - */ + /* + * Don't bother to queue an event if the mask was previously non-zero + * since an event must still be on the queue. + */ - if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - Tcl_Alloc(sizeof(FileHandlerEvent)); + if (filePtr->readyMask == 0) { + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + Tcl_Alloc(sizeof(FileHandlerEvent)); - fileEvPtr->header.proc = FileHandlerEventProc; - fileEvPtr->fd = filePtr->fd; - Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); - } - filePtr->readyMask = mask; + fileEvPtr->header.proc = FileHandlerEventProc; + fileEvPtr->fd = filePtr->fd; + Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } - return 0; + filePtr->readyMask = mask; } + return 0; } #endif /* NOTIFIER_EPOLL && TCL_THREADS */ +#else +TCL_MAC_EMPTY_FILE(unix_tclEpollNotfy_c) #endif /* !HAVE_COREFOUNDATION */ /* diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 4ddef03..ba59166 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -31,7 +31,8 @@ struct PlatformEventData; typedef struct FileHandler { - int fd; + int fd; /* File descriptor that this is describing a + * handler for. */ int mask; /* Mask of desired events: TCL_READABLE, * etc. */ int readyMask; /* Mask of events that have been seen since @@ -93,7 +94,7 @@ typedef struct ThreadSpecificData { * that are ready for I/O. */ pthread_mutex_t notifierMutex; /* Mutex protecting notifier termination in - * PlatformEventsFinalize. */ + * TclpFinalizeNotifier. */ int triggerPipe[2]; /* pipe(2) used by other threads to wake * up this thread for inter-thread IPC. */ int eventsFd; /* kqueue(2) file descriptor used to wait for @@ -111,73 +112,15 @@ static Tcl_ThreadDataKey dataKey; static void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew); -static void PlatformEventsFinalize(void); -static void PlatformEventsInit(void); static int PlatformEventsTranslate(struct kevent *eventPtr); static int PlatformEventsWait(struct kevent *events, size_t numEvents, struct timeval *timePtr); - -#include "tclUnixNotfy.c" - -/* - *---------------------------------------------------------------------- - * - * Tcl_InitNotifier -- - * - * Initializes the platform specific notifier state. - * - * Results: - * Returns a handle to the notifier state for this thread. - * - * Side effects: - * If no initNotifierProc notifier hook exists, PlatformEventsInit - * is called. - * - *---------------------------------------------------------------------- - */ - -ClientData -Tcl_InitNotifier(void) -{ - if (tclNotifierHooks.initNotifierProc) { - return tclNotifierHooks.initNotifierProc(); - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - PlatformEventsInit(); - return tsdPtr; - } -} /* - *---------------------------------------------------------------------- - * - * Tcl_FinalizeNotifier -- - * - * This function is called to cleanup the notifier state before a thread - * is terminated. - * - * Results: - * None. - * - * Side effects: - * If no finalizeNotifierProc notifier hook exists, PlatformEvents- - * Finalize is called. - * - *---------------------------------------------------------------------- + * Incorporate the base notifier implementation. */ -void -Tcl_FinalizeNotifier( - ClientData clientData) -{ - if (tclNotifierHooks.finalizeNotifierProc) { - tclNotifierHooks.finalizeNotifierProc(clientData); - return; - } else { - PlatformEventsFinalize(); - } -} +#include "tclUnixNotfy.c" /* *---------------------------------------------------------------------- @@ -209,7 +152,7 @@ Tcl_FinalizeNotifier( *---------------------------------------------------------------------- */ -void +static void PlatformEventsControl( FileHandler *filePtr, ThreadSpecificData *tsdPtr, @@ -222,7 +165,8 @@ PlatformEventsControl( struct stat fdStat; if (isNew) { - newPedPtr = (struct PlatformEventData *)Tcl_Alloc(sizeof(struct PlatformEventData)); + newPedPtr = (struct PlatformEventData *) + Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; @@ -257,12 +201,12 @@ PlatformEventsControl( switch (op) { case EV_ADD: if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) { - EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd, + EV_SET(&changeList[numChanges], (uintptr_t) filePtr->fd, EVFILT_READ, op, 0, 0, filePtr->pedPtr); numChanges++; } if (filePtr->mask & TCL_WRITABLE) { - EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd, + EV_SET(&changeList[numChanges], (uintptr_t) filePtr->fd, EVFILT_WRITE, op, 0, 0, filePtr->pedPtr); numChanges++; } @@ -284,13 +228,13 @@ PlatformEventsControl( * As one of these calls can fail, two separate kevent(2) calls are * made for EVFILT_{READ,WRITE}. */ - EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_READ, op, 0, 0, + EV_SET(&changeList[0], (uintptr_t) filePtr->fd, EVFILT_READ, op, 0, 0, NULL); if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1) && (errno != ENOENT)) { Tcl_Panic("kevent: %s", strerror(errno)); } - EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_WRITE, op, 0, 0, + EV_SET(&changeList[0], (uintptr_t) filePtr->fd, EVFILT_WRITE, op, 0, 0, NULL); if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1) && (errno != ENOENT)) { @@ -303,7 +247,7 @@ PlatformEventsControl( /* *---------------------------------------------------------------------- * - * PlatformEventsFinalize -- + * TclpFinalizeNotifier -- * * This function closes the pipe and the kqueue file descriptors and * frees the kevent structs owned by the thread of the caller. The above @@ -325,8 +269,8 @@ PlatformEventsControl( */ void -PlatformEventsFinalize( - void) +TclpFinalizeNotifier( + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -356,14 +300,16 @@ PlatformEventsFinalize( /* *---------------------------------------------------------------------- * - * PlatformEventsInit -- + * TclpInitNotifier -- + * + * Initializes the platform specific notifier state. * * This function abstracts creating a kqueue fd via the kqueue system * call and allocating memory for the kevents structs in tsdPtr for the * thread of the caller. * * Results: - * None. + * Returns a handle to the notifier state for this thread. * * Side effects: * The following per-thread entities are initialised: @@ -380,8 +326,8 @@ PlatformEventsFinalize( *---------------------------------------------------------------------- */ -void -PlatformEventsInit(void) +ClientData +TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int i, fdFl; @@ -409,16 +355,18 @@ PlatformEventsInit(void) } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) { Tcl_Panic("fcntl: %s", strerror(errno)); } - filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = tsdPtr->triggerPipe[0]; filePtr->mask = TCL_READABLE; PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1); if (!tsdPtr->readyEvents) { tsdPtr->maxReadyEvents = 512; - tsdPtr->readyEvents = (struct kevent *)Tcl_Alloc( + tsdPtr->readyEvents = (struct kevent *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); + + return tsdPtr; } /* @@ -438,7 +386,7 @@ PlatformEventsInit(void) *---------------------------------------------------------------------- */ -int +static int PlatformEventsTranslate( struct kevent *eventPtr) { @@ -459,7 +407,7 @@ PlatformEventsTranslate( } return mask; } - + /* *---------------------------------------------------------------------- * @@ -483,7 +431,7 @@ PlatformEventsTranslate( *---------------------------------------------------------------------- */ -int +static int PlatformEventsWait( struct kevent *events, size_t numEvents, @@ -538,7 +486,7 @@ PlatformEventsWait( /* *---------------------------------------------------------------------- * - * Tcl_CreateFileHandler -- + * TclpCreateFileHandler -- * * This function registers a file handler with the kqueue notifier * of the thread of the caller. @@ -554,7 +502,7 @@ PlatformEventsWait( */ void -Tcl_CreateFileHandler( +TclpCreateFileHandler( int fd, /* Handle of stream to watch. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates @@ -564,43 +512,28 @@ Tcl_CreateFileHandler( * event. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { - int isNew; - - if (tclNotifierHooks.createFileHandlerProc) { - tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); - return; - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - FileHandler *filePtr; - - for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { - if (filePtr->fd == fd) { - break; - } - } - if (filePtr == NULL) { - filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); - filePtr->fd = fd; - filePtr->readyMask = 0; - filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; - tsdPtr->firstFileHandlerPtr = filePtr; - isNew = 1; - } else { - isNew = 0; - } - filePtr->proc = proc; - filePtr->clientData = clientData; - filePtr->mask = mask; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); + int isNew = (filePtr == NULL); - PlatformEventsControl(filePtr, tsdPtr, EV_ADD, isNew); + if (isNew) { + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); + filePtr->fd = fd; + filePtr->readyMask = 0; + filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; + tsdPtr->firstFileHandlerPtr = filePtr; } -} + filePtr->proc = proc; + filePtr->clientData = clientData; + filePtr->mask = mask; + + PlatformEventsControl(filePtr, tsdPtr, EV_ADD, isNew); +} /* *---------------------------------------------------------------------- * - * Tcl_DeleteFileHandler -- + * TclpDeleteFileHandler -- * * Cancel a previously-arranged callback arrangement for a file on the * kqueue of the thread of the caller. @@ -618,60 +551,50 @@ Tcl_CreateFileHandler( */ void -Tcl_DeleteFileHandler( +TclpDeleteFileHandler( int fd) /* Stream id for which to remove callback * function. */ { - if (tclNotifierHooks.deleteFileHandlerProc) { - tclNotifierHooks.deleteFileHandlerProc(fd); - return; - } else { - FileHandler *filePtr, *prevPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + FileHandler *filePtr, *prevPtr; - /* - * Find the entry for the given file (and return if there isn't one). - */ + /* + * Find the entry for the given file (and return if there isn't one). + */ - for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; - prevPtr = filePtr, filePtr = filePtr->nextPtr) { - if (filePtr == NULL) { - return; - } - if (filePtr->fd == fd) { - break; - } - } + filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr); + if (filePtr == NULL) { + return; + } - /* - * Update the check masks for this file. - */ + /* + * Update the check masks for this file. + */ - PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0); - if (filePtr->pedPtr) { - Tcl_Free(filePtr->pedPtr); - } + PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0); + if (filePtr->pedPtr) { + Tcl_Free(filePtr->pedPtr); + } - /* - * Clean up information in the callback record. - */ + /* + * Clean up information in the callback record. + */ - if (prevPtr == NULL) { - tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; - } else { - prevPtr->nextPtr = filePtr->nextPtr; - } - Tcl_Free(filePtr); + if (prevPtr == NULL) { + tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; + } else { + prevPtr->nextPtr = filePtr->nextPtr; } + Tcl_Free(filePtr); } /* *---------------------------------------------------------------------- * - * Tcl_WaitForEvent -- + * TclpWaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on - * the message queue. If the block time is 0, then Tcl_WaitForEvent just + * the message queue. If the block time is 0, then TclpWaitForEvent just * polls without blocking. * * The waiting logic is implemented in PlatformEventsWait. @@ -687,161 +610,157 @@ Tcl_DeleteFileHandler( */ int -Tcl_WaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ +TclpWaitForEvent( + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - if (tclNotifierHooks.waitForEventProc) { - return tclNotifierHooks.waitForEventProc(timePtr); - } else { - FileHandler *filePtr; - int mask; - Tcl_Time vTime; - /* - * Impl. notes: timeout & timeoutPtr are used if, and only if threads - * are not enabled. They are the arguments for the regular epoll_wait() - * used when the core is not thread-enabled. - */ + FileHandler *filePtr; + int mask; + Tcl_Time vTime; + struct timeval timeout, *timeoutPtr; + /* Impl. notes: timeout & timeoutPtr are used + * if, and only if threads are not enabled. + * They are the arguments for the regular + * epoll_wait() used when the core is not + * thread-enabled. */ + int numFound, numEvent; + struct PlatformEventData *pedPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int numQueued; + ssize_t i; + char buf[1]; - struct timeval timeout, *timeoutPtr; - int numFound, numEvent; - struct PlatformEventData *pedPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - int numQueued; - ssize_t i; - char buf[1]; + /* + * Set up the timeout structure. Note that if there are no events to check + * for, we return with a negative result rather than blocking forever. + */ + if (timePtr != NULL) { /* - * Set up the timeout structure. Note that if there are no events to - * check for, we return with a negative result rather than blocking - * forever. + * TIP #233 (Virtualized Time). Is virtual time in effect? And do we + * actually have something to scale? If yes to both then we call the + * handler to do this scaling. */ - if (timePtr != NULL) { - /* - * TIP #233 (Virtualized Time). Is virtual time in effect? And do - * we actually have something to scale? If yes to both then we - * call the handler to do this scaling. - */ - - if (timePtr->sec != 0 || timePtr->usec != 0) { - vTime = *timePtr; - tclScaleTimeProcPtr(&vTime, tclTimeClientData); - timePtr = &vTime; - } - timeout.tv_sec = timePtr->sec; - timeout.tv_usec = timePtr->usec; - timeoutPtr = &timeout; - } else { - timeoutPtr = NULL; + if (timePtr->sec != 0 || timePtr->usec != 0) { + vTime = *timePtr; + TclScaleTime(&vTime); + timePtr = &vTime; + } + timeout.tv_sec = timePtr->sec; + timeout.tv_usec = timePtr->usec; + timeoutPtr = &timeout; + } else { + timeoutPtr = NULL; + } + + /* + * Walk the list of FileHandlers associated with regular files (S_IFREG) + * belonging to tsdPtr, queue Tcl events for them, and update their mask + * of events of interest. + * + * kqueue(2), unlike epoll(7), does support regular files, but EVFILT_READ + * only `[r]eturns when the file pointer is not at the end of file' as + * opposed to unconditionally. While FreeBSD 11.0-RELEASE adds support for + * this mode (NOTE_FILE_POLL,) this is not used for reasons of + * compatibility. + * + * Therefore, the behaviour of {select,poll}(2) is simply simulated here: + * fds associated with regular files are added to this list by + * PlatformEventsControl() and processed here before calling (and possibly + * blocking) on PlatformEventsWait(). + */ + + numQueued = 0; + LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) { + mask = 0; + if (filePtr->mask & TCL_READABLE) { + mask |= TCL_READABLE; + } + if (filePtr->mask & TCL_WRITABLE) { + mask |= TCL_WRITABLE; } /* - * Walk the list of FileHandlers associated with regular files - * (S_IFREG) belonging to tsdPtr, queue Tcl events for them, and - * update their mask of events of interest. - * - * kqueue(2), unlike epoll(7), does support regular files, but - * EVFILT_READ only `[r]eturns when the file pointer is not at the end - * of file' as opposed to unconditionally. While FreeBSD 11.0-RELEASE - * adds support for this mode (NOTE_FILE_POLL,) this is not used for - * reasons of compatibility. - * - * Therefore, the behaviour of {select,poll}(2) is simply simulated - * here: fds associated with regular files are added to this list by - * PlatformEventsControl() and processed here before calling (and - * possibly blocking) on PlatformEventsWait(). + * Don't bother to queue an event if the mask was previously non-zero + * since an event must still be on the queue. */ - numQueued = 0; - LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) { - mask = 0; - if (filePtr->mask & TCL_READABLE) { - mask |= TCL_READABLE; - } - if (filePtr->mask & TCL_WRITABLE) { - mask |= TCL_WRITABLE; - } + if (filePtr->readyMask == 0) { + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + Tcl_Alloc(sizeof(FileHandlerEvent)); + + fileEvPtr->header.proc = FileHandlerEventProc; + fileEvPtr->fd = filePtr->fd; + Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); + numQueued++; + } + filePtr->readyMask = mask; + } + + /* + * If any events were queued in the above loop, force PlatformEventsWait() + * to poll as there already are events that need to be processed at this + * point. + */ - /* - * Don't bother to queue an event if the mask was previously - * non-zero since an event must still be on the queue. - */ + if (numQueued) { + timeout.tv_sec = 0; + timeout.tv_usec = 0; + timeoutPtr = &timeout; + } - if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - Tcl_Alloc(sizeof(FileHandlerEvent)); + /* + * Wait or poll for new events, queue Tcl events for the FileHandlers + * corresponding to them, and update the FileHandlers' mask of events of + * interest registered by the last call to Tcl_CreateFileHandler(). + * + * Events for the trigger pipe are processed here in order to facilitate + * inter-thread IPC. If another thread intends to wake up this thread + * whilst it's blocking on PlatformEventsWait(), it write(2)s to the other + * end of the pipe (see Tcl_AlertNotifier(),) which in turn will cause + * PlatformEventsWait() to return immediately. + */ - fileEvPtr->header.proc = FileHandlerEventProc; - fileEvPtr->fd = filePtr->fd; - Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); - numQueued++; + numFound = PlatformEventsWait(tsdPtr->readyEvents, + tsdPtr->maxReadyEvents, timeoutPtr); + for (numEvent = 0; numEvent < numFound; numEvent++) { + pedPtr = (struct PlatformEventData *) + tsdPtr->readyEvents[numEvent].udata; + filePtr = pedPtr->filePtr; + mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]); + if (filePtr->fd == tsdPtr->triggerPipe[0]) { + i = read(tsdPtr->triggerPipe[0], buf, 1); + if ((i == -1) && (errno != EAGAIN)) { + Tcl_Panic("Tcl_WaitForEvent: read from %p->triggerPipe: %s", + (void *) tsdPtr, strerror(errno)); } - filePtr->readyMask = mask; + continue; } - - /* - * If any events were queued in the above loop, force PlatformEvents- - * Wait() to poll as there already are events that need to be processed - * at this point. - */ - - if (numQueued) { - timeout.tv_sec = 0; - timeout.tv_usec = 0; - timeoutPtr = &timeout; + if (!mask) { + continue; } /* - * Wait or poll for new events, queue Tcl events for the FileHandlers - * corresponding to them, and update the FileHandlers' mask of events - * of interest registered by the last call to Tcl_CreateFileHandler(). - * - * Events for the trigger pipe are processed here in order to facilitate - * inter-thread IPC. If another thread intends to wake up this thread - * whilst it's blocking on PlatformEventsWait(), it write(2)s to the - * other end of the pipe (see Tcl_AlertNotifier(),) which in turn will - * cause PlatformEventsWait() to return immediately. + * Don't bother to queue an event if the mask was previously non-zero + * since an event must still be on the queue. */ - numFound = PlatformEventsWait(tsdPtr->readyEvents, - tsdPtr->maxReadyEvents, timeoutPtr); - for (numEvent = 0; numEvent < numFound; numEvent++) { - pedPtr = (struct PlatformEventData *) - tsdPtr->readyEvents[numEvent].udata; - filePtr = pedPtr->filePtr; - mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]); - if (filePtr->fd == tsdPtr->triggerPipe[0]) { - i = read(tsdPtr->triggerPipe[0], buf, 1); - if ((i == -1) && (errno != EAGAIN)) { - Tcl_Panic("Tcl_WaitForEvent: read from %p->triggerPipe: %s", - (void *) tsdPtr, strerror(errno)); - } - continue; - } - if (!mask) { - continue; - } - - /* - * Don't bother to queue an event if the mask was previously - * non-zero since an event must still be on the queue. - */ + if (filePtr->readyMask == 0) { + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + Tcl_Alloc(sizeof(FileHandlerEvent)); - if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - Tcl_Alloc(sizeof(FileHandlerEvent)); - - fileEvPtr->header.proc = FileHandlerEventProc; - fileEvPtr->fd = filePtr->fd; - Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); - } - filePtr->readyMask |= mask; + fileEvPtr->header.proc = FileHandlerEventProc; + fileEvPtr->fd = filePtr->fd; + Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } - return 0; + filePtr->readyMask |= mask; } + return 0; } #endif /* NOTIFIER_KQUEUE && TCL_THREADS */ +#else +TCL_MAC_EMPTY_FILE(unix_tclKqueueNotfy_c) #endif /* !HAVE_COREFOUNDATION */ /* diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index 2c63575..e1d577f 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -216,8 +216,8 @@ extern "C" { typedef struct { void *hwnd; /* Messaging window. */ unsigned int *message; /* Message payload. */ - size_t wParam; /* Event-specific "word" parameter. */ - size_t lParam; /* Event-specific "long" parameter. */ + size_t wParam; /* Event-specific "word" parameter. */ + size_t lParam; /* Event-specific "long" parameter. */ int time; /* Event timestamp. */ int x; /* Event location (where meaningful). */ int y; @@ -244,8 +244,8 @@ extern void __stdcall CloseHandle(void *); extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char, void *); extern void *__stdcall CreateWindowExW(void *, const void *, const void *, - unsigned int, int, int, int, int, void *, void *, void *, - void *); + unsigned int, int, int, int, int, void *, void *, + void *, void *); extern unsigned int __stdcall DefWindowProcW(void *, int, void *, void *); extern unsigned char __stdcall DestroyWindow(void *); extern int __stdcall DispatchMessageW(const MSG *); @@ -271,14 +271,17 @@ static unsigned int __stdcall NotifierProc(void *hwnd, unsigned int message, } #endif #endif /* TCL_THREADS && __CYGWIN__ */ - +/* + * Incorporate the base notifier implementation. + */ + #include "tclUnixNotfy.c" /* *---------------------------------------------------------------------- * - * Tcl_InitNotifier -- + * TclpInitNotifier -- * * Initializes the platform specific notifier state. * @@ -292,75 +295,72 @@ static unsigned int __stdcall NotifierProc(void *hwnd, unsigned int message, */ ClientData -Tcl_InitNotifier(void) +TclpInitNotifier(void) { - if (tclNotifierHooks.initNotifierProc) { - return tclNotifierHooks.initNotifierProc(); - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if TCL_THREADS - tsdPtr->eventReady = 0; + tsdPtr->eventReady = 0; - /* - * Initialize thread specific condition variable for this thread. - */ - if (tsdPtr->waitCVinitialized == 0) { + /* + * Initialize thread specific condition variable for this thread. + */ + + if (tsdPtr->waitCVinitialized == 0) { #ifdef __CYGWIN__ - WNDCLASSW clazz; - - clazz.style = 0; - clazz.cbClsExtra = 0; - clazz.cbWndExtra = 0; - clazz.hInstance = TclWinGetTclInstance(); - clazz.hbrBackground = NULL; - clazz.lpszMenuName = NULL; - clazz.lpszClassName = className; - clazz.lpfnWndProc = (void *)NotifierProc; - clazz.hIcon = NULL; - clazz.hCursor = NULL; - - RegisterClassW(&clazz); - tsdPtr->hwnd = CreateWindowExW(NULL, clazz.lpszClassName, - clazz.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL, - clazz.hInstance, NULL); - tsdPtr->event = CreateEventW(NULL, 1 /* manual */, - 0 /* !signaled */, NULL); -#else - pthread_cond_init(&tsdPtr->waitCV, NULL); + WNDCLASSW clazz; + + clazz.style = 0; + clazz.cbClsExtra = 0; + clazz.cbWndExtra = 0; + clazz.hInstance = TclWinGetTclInstance(); + clazz.hbrBackground = NULL; + clazz.lpszMenuName = NULL; + clazz.lpszClassName = className; + clazz.lpfnWndProc = (void *) NotifierProc; + clazz.hIcon = NULL; + clazz.hCursor = NULL; + + RegisterClassW(&clazz); + tsdPtr->hwnd = CreateWindowExW(NULL, clazz.lpszClassName, + clazz.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL, + clazz.hInstance, NULL); + tsdPtr->event = CreateEventW(NULL, 1 /* manual */, + 0 /* !signaled */, NULL); +#else /* !__CYGWIN__ */ + pthread_cond_init(&tsdPtr->waitCV, NULL); #endif /* __CYGWIN__ */ - tsdPtr->waitCVinitialized = 1; - } + tsdPtr->waitCVinitialized = 1; + } - pthread_mutex_lock(¬ifierInitMutex); + pthread_mutex_lock(¬ifierInitMutex); #if defined(HAVE_PTHREAD_ATFORK) - /* - * Install pthread_atfork handlers to clean up the notifier in the - * child of a fork. - */ + /* + * Install pthread_atfork handlers to clean up the notifier in the child + * of a fork. + */ - if (!atForkInit) { - int result = pthread_atfork(NULL, NULL, AtForkChild); + if (!atForkInit) { + int result = pthread_atfork(NULL, NULL, AtForkChild); - if (result) { - Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed"); - } - atForkInit = 1; + if (result) { + Tcl_Panic("Tcl_InitNotifier: %s", "pthread_atfork failed"); } + atForkInit = 1; + } #endif /* HAVE_PTHREAD_ATFORK */ - notifierCount++; - pthread_mutex_unlock(¬ifierInitMutex); - + notifierCount++; + pthread_mutex_unlock(¬ifierInitMutex); #endif /* TCL_THREADS */ - return tsdPtr; - } + + return tsdPtr; } /* *---------------------------------------------------------------------- * - * Tcl_FinalizeNotifier -- + * TclpFinalizeNotifier -- * * This function is called to cleanup the notifier state before a thread * is terminated. @@ -376,67 +376,62 @@ Tcl_InitNotifier(void) */ void -Tcl_FinalizeNotifier( +TclpFinalizeNotifier( ClientData clientData) { - if (tclNotifierHooks.finalizeNotifierProc) { - tclNotifierHooks.finalizeNotifierProc(clientData); - return; - } else { #if TCL_THREADS - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - pthread_mutex_lock(¬ifierInitMutex); - notifierCount--; + pthread_mutex_lock(¬ifierInitMutex); + notifierCount--; - /* - * If this is the last thread to use the notifier, close the notifier - * pipe and wait for the background thread to terminate. - */ + /* + * If this is the last thread to use the notifier, close the notifier pipe + * and wait for the background thread to terminate. + */ - if (notifierCount == 0 && triggerPipe != -1) { - if (write(triggerPipe, "q", 1) != 1) { - Tcl_Panic("Tcl_FinalizeNotifier: %s", - "unable to write 'q' to triggerPipe"); - } - close(triggerPipe); - pthread_mutex_lock(¬ifierMutex); - while(triggerPipe != -1) { - pthread_cond_wait(¬ifierCV, ¬ifierMutex); - } - pthread_mutex_unlock(¬ifierMutex); - if (notifierThreadRunning) { - int result = pthread_join((pthread_t) notifierThread, NULL); + if (notifierCount == 0 && triggerPipe != -1) { + if (write(triggerPipe, "q", 1) != 1) { + Tcl_Panic("Tcl_FinalizeNotifier: %s", + "unable to write 'q' to triggerPipe"); + } + close(triggerPipe); + pthread_mutex_lock(¬ifierMutex); + while(triggerPipe != -1) { + pthread_cond_wait(¬ifierCV, ¬ifierMutex); + } + pthread_mutex_unlock(¬ifierMutex); + if (notifierThreadRunning) { + int result = pthread_join((pthread_t) notifierThread, NULL); - if (result) { - Tcl_Panic("Tcl_FinalizeNotifier: %s", - "unable to join notifier thread"); - } - notifierThreadRunning = 0; + if (result) { + Tcl_Panic("Tcl_FinalizeNotifier: %s", + "unable to join notifier thread"); } + notifierThreadRunning = 0; } + } - /* - * Clean up any synchronization objects in the thread local storage. - */ + /* + * Clean up any synchronization objects in the thread local storage. + */ #ifdef __CYGWIN__ - DestroyWindow(tsdPtr->hwnd); - CloseHandle(tsdPtr->event); -#else /* __CYGWIN__ */ - pthread_cond_destroy(&tsdPtr->waitCV); + DestroyWindow(tsdPtr->hwnd); + CloseHandle(tsdPtr->event); +#else /* !__CYGWIN__ */ + pthread_cond_destroy(&tsdPtr->waitCV); #endif /* __CYGWIN__ */ - tsdPtr->waitCVinitialized = 0; + tsdPtr->waitCVinitialized = 0; - pthread_mutex_unlock(¬ifierInitMutex); + pthread_mutex_unlock(¬ifierInitMutex); #endif /* TCL_THREADS */ - } } /* *---------------------------------------------------------------------- * - * Tcl_CreateFileHandler -- + * TclpCreateFileHandler -- * * This function registers a file handler with the select notifier. * @@ -450,7 +445,7 @@ Tcl_FinalizeNotifier( */ void -Tcl_CreateFileHandler( +TclpCreateFileHandler( int fd, /* Handle of stream to watch. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates @@ -460,59 +455,48 @@ Tcl_CreateFileHandler( * event. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { - if (tclNotifierHooks.createFileHandlerProc) { - tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); - return; - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - FileHandler *filePtr; - - for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { - if (filePtr->fd == fd) { - break; - } - } - if (filePtr == NULL) { - filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); - filePtr->fd = fd; - filePtr->readyMask = 0; - filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; - tsdPtr->firstFileHandlerPtr = filePtr; - } - filePtr->proc = proc; - filePtr->clientData = clientData; - filePtr->mask = mask; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); + + if (filePtr == NULL) { + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); + filePtr->fd = fd; + filePtr->readyMask = 0; + filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; + tsdPtr->firstFileHandlerPtr = filePtr; + } + filePtr->proc = proc; + filePtr->clientData = clientData; + filePtr->mask = mask; - /* - * Update the check masks for this file. - */ + /* + * Update the check masks for this file. + */ - if (mask & TCL_READABLE) { - FD_SET(fd, &tsdPtr->checkMasks.readable); - } else { - FD_CLR(fd, &tsdPtr->checkMasks.readable); - } - if (mask & TCL_WRITABLE) { - FD_SET(fd, &tsdPtr->checkMasks.writable); - } else { - FD_CLR(fd, &tsdPtr->checkMasks.writable); - } - if (mask & TCL_EXCEPTION) { - FD_SET(fd, &tsdPtr->checkMasks.exception); - } else { - FD_CLR(fd, &tsdPtr->checkMasks.exception); - } - if (tsdPtr->numFdBits <= fd) { - tsdPtr->numFdBits = fd+1; - } + if (mask & TCL_READABLE) { + FD_SET(fd, &tsdPtr->checkMasks.readable); + } else { + FD_CLR(fd, &tsdPtr->checkMasks.readable); + } + if (mask & TCL_WRITABLE) { + FD_SET(fd, &tsdPtr->checkMasks.writable); + } else { + FD_CLR(fd, &tsdPtr->checkMasks.writable); + } + if (mask & TCL_EXCEPTION) { + FD_SET(fd, &tsdPtr->checkMasks.exception); + } else { + FD_CLR(fd, &tsdPtr->checkMasks.exception); + } + if (tsdPtr->numFdBits <= fd) { + tsdPtr->numFdBits = fd + 1; } } /* *---------------------------------------------------------------------- * - * Tcl_DeleteFileHandler -- + * TclpDeleteFileHandler -- * * Cancel a previously-arranged callback arrangement for a file. * @@ -526,75 +510,65 @@ Tcl_CreateFileHandler( */ void -Tcl_DeleteFileHandler( +TclpDeleteFileHandler( int fd) /* Stream id for which to remove callback * function. */ { - if (tclNotifierHooks.deleteFileHandlerProc) { - tclNotifierHooks.deleteFileHandlerProc(fd); - return; - } else { - FileHandler *filePtr, *prevPtr; - int i; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + FileHandler *filePtr, *prevPtr; + int i; - /* - * Find the entry for the given file (and return if there isn't one). - */ + /* + * Find the entry for the given file (and return if there isn't one). + */ - for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; - prevPtr = filePtr, filePtr = filePtr->nextPtr) { - if (filePtr == NULL) { - return; - } - if (filePtr->fd == fd) { - break; - } - } + filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr); + if (filePtr == NULL) { + return; + } - /* - * Update the check masks for this file. - */ + /* + * Update the check masks for this file. + */ - if (filePtr->mask & TCL_READABLE) { - FD_CLR(fd, &tsdPtr->checkMasks.readable); - } - if (filePtr->mask & TCL_WRITABLE) { - FD_CLR(fd, &tsdPtr->checkMasks.writable); - } - if (filePtr->mask & TCL_EXCEPTION) { - FD_CLR(fd, &tsdPtr->checkMasks.exception); - } + if (filePtr->mask & TCL_READABLE) { + FD_CLR(fd, &tsdPtr->checkMasks.readable); + } + if (filePtr->mask & TCL_WRITABLE) { + FD_CLR(fd, &tsdPtr->checkMasks.writable); + } + if (filePtr->mask & TCL_EXCEPTION) { + FD_CLR(fd, &tsdPtr->checkMasks.exception); + } - /* - * Find current max fd. - */ + /* + * Find current max fd. + */ - if (fd+1 == tsdPtr->numFdBits) { - int numFdBits = 0; + if (fd + 1 == tsdPtr->numFdBits) { + int numFdBits = 0; - for (i = fd-1; i >= 0; i--) { - if (FD_ISSET(i, &tsdPtr->checkMasks.readable) - || FD_ISSET(i, &tsdPtr->checkMasks.writable) - || FD_ISSET(i, &tsdPtr->checkMasks.exception)) { - numFdBits = i+1; - break; - } + for (i = fd - 1; i >= 0; i--) { + if (FD_ISSET(i, &tsdPtr->checkMasks.readable) + || FD_ISSET(i, &tsdPtr->checkMasks.writable) + || FD_ISSET(i, &tsdPtr->checkMasks.exception)) { + numFdBits = i + 1; + break; } - tsdPtr->numFdBits = numFdBits; } + tsdPtr->numFdBits = numFdBits; + } - /* - * Clean up information in the callback record. - */ + /* + * Clean up information in the callback record. + */ - if (prevPtr == NULL) { - tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; - } else { - prevPtr->nextPtr = filePtr->nextPtr; - } - Tcl_Free(filePtr); + if (prevPtr == NULL) { + tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; + } else { + prevPtr->nextPtr = filePtr->nextPtr; } + Tcl_Free(filePtr); } #if defined(__CYGWIN__) @@ -625,7 +599,7 @@ NotifierProc( /* *---------------------------------------------------------------------- * - * Tcl_WaitForEvent -- + * TclpWaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on * the message queue. If the block time is 0, then Tcl_WaitForEvent just @@ -641,265 +615,261 @@ NotifierProc( */ int -Tcl_WaitForEvent( +TclpWaitForEvent( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - if (tclNotifierHooks.waitForEventProc) { - return tclNotifierHooks.waitForEventProc(timePtr); - } else { - FileHandler *filePtr; - int mask; - Tcl_Time vTime; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + FileHandler *filePtr; + int mask; + Tcl_Time vTime; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if TCL_THREADS - int waitForFiles; + int waitForFiles; # ifdef __CYGWIN__ - MSG msg; + MSG msg; # endif /* __CYGWIN__ */ #else /* !TCL_THREADS */ - /* - * Impl. notes: timeout & timeoutPtr are used if, and only if threads - * are not enabled. They are the arguments for the regular select() - * used when the core is not thread-enabled. - */ + /* + * Impl. notes: timeout & timeoutPtr are used if, and only if threads are + * not enabled. They are the arguments for the regular select() used when + * the core is not thread-enabled. + */ - struct timeval timeout, *timeoutPtr; - int numFound; + struct timeval timeout, *timeoutPtr; + int numFound; #endif /* TCL_THREADS */ + /* + * Set up the timeout structure. Note that if there are no events to check + * for, we return with a negative result rather than blocking forever. + */ + + if (timePtr != NULL) { /* - * Set up the timeout structure. Note that if there are no events to - * check for, we return with a negative result rather than blocking - * forever. + * TIP #233 (Virtualized Time). Is virtual time in effect? And do we + * actually have something to scale? If yes to both then we call the + * handler to do this scaling. */ - if (timePtr != NULL) { - /* - * TIP #233 (Virtualized Time). Is virtual time in effect? And do - * we actually have something to scale? If yes to both then we - * call the handler to do this scaling. - */ - - if (timePtr->sec != 0 || timePtr->usec != 0) { - vTime = *timePtr; - tclScaleTimeProcPtr(&vTime, tclTimeClientData); - timePtr = &vTime; - } + if (timePtr->sec != 0 || timePtr->usec != 0) { + vTime = *timePtr; + TclScaleTime(&vTime); + timePtr = &vTime; + } #if !TCL_THREADS - timeout.tv_sec = timePtr->sec; - timeout.tv_usec = timePtr->usec; - timeoutPtr = &timeout; - } else if (tsdPtr->numFdBits == 0) { - /* - * If there are no threads, no timeout, and no fds registered, - * then there are no events possible and we must avoid deadlock. - * Note that this is not entirely correct because there might be a - * signal that could interrupt the select call, but we don't - * handle that case if we aren't using threads. - */ + timeout.tv_sec = timePtr->sec; + timeout.tv_usec = timePtr->usec; + timeoutPtr = &timeout; + } else if (tsdPtr->numFdBits == 0) { + /* + * If there are no threads, no timeout, and no fds registered, then + * there are no events possible and we must avoid deadlock. Note that + * this is not entirely correct because there might be a signal that + * could interrupt the select call, but we don't handle that case if + * we aren't using threads. + */ - return -1; - } else { - timeoutPtr = NULL; + return -1; + } else { + timeoutPtr = NULL; #endif /* !TCL_THREADS */ - } + } #if TCL_THREADS - /* - * Start notifier thread and place this thread on the list of - * interested threads, signal the notifier thread, and wait for a - * response or a timeout. - */ - StartNotifierThread("Tcl_WaitForEvent"); + /* + * Start notifier thread and place this thread on the list of interested + * threads, signal the notifier thread, and wait for a response or a + * timeout. + */ - pthread_mutex_lock(¬ifierMutex); + StartNotifierThread("Tcl_WaitForEvent"); + + pthread_mutex_lock(¬ifierMutex); - if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0 + if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0 #if defined(__APPLE__) && defined(__LP64__) - /* - * On 64-bit Darwin, pthread_cond_timedwait() appears to have - * a bug that causes it to wait forever when passed an - * absolute time which has already been exceeded by the system - * time; as a workaround, when given a very brief timeout, - * just do a poll. [Bug 1457797] - */ - || timePtr->usec < 10 -#endif /* __APPLE__ && __LP64__ */ - )) { /* - * Cannot emulate a polling select with a polling condition - * variable. Instead, pretend to wait for files and tell the - * notifier thread what we are doing. The notifier thread makes - * sure it goes through select with its select mask in the same - * state as ours currently is. We block until that happens. + * On 64-bit Darwin, pthread_cond_timedwait() appears to have a + * bug that causes it to wait forever when passed an absolute time + * which has already been exceeded by the system time; as a + * workaround, when given a very brief timeout, just do a poll. + * [Bug 1457797] */ + || timePtr->usec < 10 +#endif /* __APPLE__ && __LP64__ */ + )) { + /* + * Cannot emulate a polling select with a polling condition variable. + * Instead, pretend to wait for files and tell the notifier thread + * what we are doing. The notifier thread makes sure it goes through + * select with its select mask in the same state as ours currently is. + * We block until that happens. + */ - waitForFiles = 1; - tsdPtr->pollState = POLL_WANT; - timePtr = NULL; - } else { - waitForFiles = (tsdPtr->numFdBits > 0); - tsdPtr->pollState = 0; - } + waitForFiles = 1; + tsdPtr->pollState = POLL_WANT; + timePtr = NULL; + } else { + waitForFiles = (tsdPtr->numFdBits > 0); + tsdPtr->pollState = 0; + } - if (waitForFiles) { - /* - * Add the ThreadSpecificData structure of this thread to the list - * of ThreadSpecificData structures of all threads that are - * waiting on file events. - */ + if (waitForFiles) { + /* + * Add the ThreadSpecificData structure of this thread to the list of + * ThreadSpecificData structures of all threads that are waiting on + * file events. + */ - tsdPtr->nextPtr = waitingListPtr; - if (waitingListPtr) { - waitingListPtr->prevPtr = tsdPtr; - } - tsdPtr->prevPtr = 0; - waitingListPtr = tsdPtr; - tsdPtr->onList = 1; + tsdPtr->nextPtr = waitingListPtr; + if (waitingListPtr) { + waitingListPtr->prevPtr = tsdPtr; + } + tsdPtr->prevPtr = 0; + waitingListPtr = tsdPtr; + tsdPtr->onList = 1; - if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { - Tcl_Panic("Tcl_WaitForEvent: %s", - "unable to write to triggerPipe"); - } + if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { + Tcl_Panic("Tcl_WaitForEvent: %s", + "unable to write to triggerPipe"); } + } - FD_ZERO(&tsdPtr->readyMasks.readable); - FD_ZERO(&tsdPtr->readyMasks.writable); - FD_ZERO(&tsdPtr->readyMasks.exception); + FD_ZERO(&tsdPtr->readyMasks.readable); + FD_ZERO(&tsdPtr->readyMasks.writable); + FD_ZERO(&tsdPtr->readyMasks.exception); - if (!tsdPtr->eventReady) { + if (!tsdPtr->eventReady) { #ifdef __CYGWIN__ - if (!PeekMessageW(&msg, NULL, 0, 0, 0)) { - unsigned int timeout; + if (!PeekMessageW(&msg, NULL, 0, 0, 0)) { + unsigned int timeout; - if (timePtr) { - timeout = timePtr->sec * 1000 + timePtr->usec / 1000; - } else { - timeout = 0xFFFFFFFF; - } - pthread_mutex_unlock(¬ifierMutex); - MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279); - pthread_mutex_lock(¬ifierMutex); + if (timePtr) { + timeout = timePtr->sec * 1000 + timePtr->usec / 1000; + } else { + timeout = 0xFFFFFFFF; } + pthread_mutex_unlock(¬ifierMutex); + MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279); + pthread_mutex_lock(¬ifierMutex); + } #else /* !__CYGWIN__ */ - if (timePtr != NULL) { - Tcl_Time now; - struct timespec ptime; + if (timePtr != NULL) { + Tcl_Time now; + struct timespec ptime; - Tcl_GetTime(&now); - ptime.tv_sec = timePtr->sec + now.sec + - (timePtr->usec + now.usec) / 1000000; - ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000); + Tcl_GetTime(&now); + ptime.tv_sec = timePtr->sec + now.sec + + (timePtr->usec + now.usec) / 1000000; + ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000); - pthread_cond_timedwait(&tsdPtr->waitCV, ¬ifierMutex, &ptime); - } else { - pthread_cond_wait(&tsdPtr->waitCV, ¬ifierMutex); - } -#endif /* __CYGWIN__ */ + pthread_cond_timedwait(&tsdPtr->waitCV, ¬ifierMutex, &ptime); + } else { + pthread_cond_wait(&tsdPtr->waitCV, ¬ifierMutex); } - tsdPtr->eventReady = 0; +#endif /* __CYGWIN__ */ + } + tsdPtr->eventReady = 0; #ifdef __CYGWIN__ - while (PeekMessageW(&msg, NULL, 0, 0, 0)) { - /* - * Retrieve and dispatch the message. - */ + while (PeekMessageW(&msg, NULL, 0, 0, 0)) { + /* + * Retrieve and dispatch the message. + */ - unsigned int result = GetMessageW(&msg, NULL, 0, 0); + unsigned int result = GetMessageW(&msg, NULL, 0, 0); - if (result == 0) { - PostQuitMessage(msg.wParam); - /* What to do here? */ - } else if (result != (unsigned int) -1) { - TranslateMessage(&msg); - DispatchMessageW(&msg); - } + if (result == 0) { + PostQuitMessage(msg.wParam); + /* What to do here? */ + } else if (result != (unsigned int) -1) { + TranslateMessage(&msg); + DispatchMessageW(&msg); } - ResetEvent(tsdPtr->event); + } + ResetEvent(tsdPtr->event); #endif /* __CYGWIN__ */ - if (waitForFiles && tsdPtr->onList) { - /* - * Remove the ThreadSpecificData structure of this thread from the - * waiting list. Alert the notifier thread to recompute its select - * masks - skipping this caused a hang when trying to close a pipe - * which the notifier thread was still doing a select on. - */ + if (waitForFiles && tsdPtr->onList) { + /* + * Remove the ThreadSpecificData structure of this thread from the + * waiting list. Alert the notifier thread to recompute its select + * masks - skipping this caused a hang when trying to close a pipe + * which the notifier thread was still doing a select on. + */ - if (tsdPtr->prevPtr) { - tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; - } else { - waitingListPtr = tsdPtr->nextPtr; - } - if (tsdPtr->nextPtr) { - tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; - } - tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; - tsdPtr->onList = 0; - if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { - Tcl_Panic("Tcl_WaitForEvent: %s", - "unable to write to triggerPipe"); - } + if (tsdPtr->prevPtr) { + tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; + } else { + waitingListPtr = tsdPtr->nextPtr; + } + if (tsdPtr->nextPtr) { + tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } + tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; + tsdPtr->onList = 0; + if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { + Tcl_Panic("Tcl_WaitForEvent: %s", + "unable to write to triggerPipe"); + } + } #else /* !TCL_THREADS */ - tsdPtr->readyMasks = tsdPtr->checkMasks; - numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable, - &tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception, - timeoutPtr); + tsdPtr->readyMasks = tsdPtr->checkMasks; + numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable, + &tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception, + timeoutPtr); - /* - * Some systems don't clear the masks after an error, so we have to do - * it here. - */ + /* + * Some systems don't clear the masks after an error, so we have to do it + * here. + */ - if (numFound == -1) { - FD_ZERO(&tsdPtr->readyMasks.readable); - FD_ZERO(&tsdPtr->readyMasks.writable); - FD_ZERO(&tsdPtr->readyMasks.exception); - } + if (numFound == -1) { + FD_ZERO(&tsdPtr->readyMasks.readable); + FD_ZERO(&tsdPtr->readyMasks.writable); + FD_ZERO(&tsdPtr->readyMasks.exception); + } #endif /* TCL_THREADS */ - /* - * Queue all detected file events before returning. - */ + /* + * Queue all detected file events before returning. + */ - for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL); - filePtr = filePtr->nextPtr) { - mask = 0; - if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) { - mask |= TCL_READABLE; - } - if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) { - mask |= TCL_WRITABLE; - } - if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) { - mask |= TCL_EXCEPTION; - } + for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL); + filePtr = filePtr->nextPtr) { + mask = 0; + if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) { + mask |= TCL_READABLE; + } + if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) { + mask |= TCL_WRITABLE; + } + if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) { + mask |= TCL_EXCEPTION; + } - if (!mask) { - continue; - } + if (!mask) { + continue; + } - /* - * Don't bother to queue an event if the mask was previously - * non-zero since an event must still be on the queue. - */ + /* + * Don't bother to queue an event if the mask was previously non-zero + * since an event must still be on the queue. + */ - if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = - (FileHandlerEvent *)Tcl_Alloc(sizeof(FileHandlerEvent)); + if (filePtr->readyMask == 0) { + FileHandlerEvent *fileEvPtr = + (FileHandlerEvent *) Tcl_Alloc(sizeof(FileHandlerEvent)); - fileEvPtr->header.proc = FileHandlerEventProc; - fileEvPtr->fd = filePtr->fd; - Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); - } - filePtr->readyMask = mask; + fileEvPtr->header.proc = FileHandlerEventProc; + fileEvPtr->fd = filePtr->fd; + Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } + filePtr->readyMask = mask; + } #if TCL_THREADS - pthread_mutex_unlock(¬ifierMutex); + pthread_mutex_unlock(¬ifierMutex); #endif /* TCL_THREADS */ - return 0; - } + return 0; } /* @@ -916,8 +886,9 @@ Tcl_WaitForEvent( * byte to a special pipe that the notifier thread is monitoring. * * Result: - * None. Once started, this routine never exits. It dies with the overall - * process. + * None. Once started, this routine normally never exits and usually dies + * with the overall process, but it can be shut down if the Tcl library + * is finalized. * * Side effects: * The trigger pipe used to signal the notifier thread is created when @@ -1048,7 +1019,7 @@ NotifierThreadProc( for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { found = 0; - for (i = tsdPtr->numFdBits-1; i >= 0; --i) { + for (i = tsdPtr->numFdBits - 1; i >= 0; --i) { if (FD_ISSET(i, &tsdPtr->checkMasks.readable) && FD_ISSET(i, &readableMask)) { FD_SET(i, &tsdPtr->readyMasks.readable); @@ -1113,6 +1084,8 @@ NotifierThreadProc( #endif /* TCL_THREADS */ #endif /* (!NOTIFIER_EPOLL && !NOTIFIER_KQUEUE) || !TCL_THREADS */ +#else +TCL_MAC_EMPTY_FILE(unix_tclSelectNotfy_c) #endif /* !HAVE_COREFOUNDATION */ /* diff --git a/unix/tclUnixEvent.c b/unix/tclUnixEvent.c index aff7797..0047dd9 100644 --- a/unix/tclUnixEvent.c +++ b/unix/tclUnixEvent.c @@ -64,7 +64,7 @@ Tcl_Sleep( } if ((vdelay.sec != 0) || (vdelay.usec != 0)) { - tclScaleTimeProcPtr(&vdelay, tclTimeClientData); + TclScaleTime(&vdelay); } delay.tv_sec = vdelay.sec; @@ -85,6 +85,8 @@ Tcl_Sleep( } } +#else +TCL_MAC_EMPTY_FILE(unix_tclUnixEvent_c) #endif /* HAVE_COREFOUNDATION */ /* * Local Variables: diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index d992d65..0be9ed4 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -2,10 +2,12 @@ * tclUnixNotfy.c -- * * This file contains subroutines shared by all notifier backend - * implementations on *nix platforms. + * implementations on *nix platforms. It is *included* by the epoll, + * kqueue and select notifier implementation files. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de> + * Copyright © 2021 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -45,8 +47,10 @@ static void AtForkChild(void); * *---------------------------------------------------------------------- */ + static void -StartNotifierThread(const char *proc) +StartNotifierThread( + const char *proc) { if (!notifierThreadRunning) { pthread_mutex_lock(¬ifierInitMutex); @@ -57,6 +61,7 @@ StartNotifierThread(const char *proc) } pthread_mutex_lock(¬ifierMutex); + /* * Wait for the notifier pipe to be created. */ @@ -76,7 +81,7 @@ StartNotifierThread(const char *proc) /* *---------------------------------------------------------------------- * - * Tcl_AlertNotifier -- + * TclpAlertNotifier -- * * Wake up the specified notifier from any thread. This routine is called * by the platform independent notifier code whenever the Tcl_ThreadAlert @@ -99,50 +104,97 @@ StartNotifierThread(const char *proc) */ void -Tcl_AlertNotifier( +TclpAlertNotifier( ClientData clientData) { - if (tclNotifierHooks.alertNotifierProc) { - tclNotifierHooks.alertNotifierProc(clientData); - return; - } else { #ifdef NOTIFIER_SELECT #if TCL_THREADS - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; - pthread_mutex_lock(¬ifierMutex); - tsdPtr->eventReady = 1; + pthread_mutex_lock(¬ifierMutex); + tsdPtr->eventReady = 1; # ifdef __CYGWIN__ - PostMessageW(tsdPtr->hwnd, 1024, 0, 0); + PostMessageW(tsdPtr->hwnd, 1024, 0, 0); # else - pthread_cond_broadcast(&tsdPtr->waitCV); + pthread_cond_broadcast(&tsdPtr->waitCV); # endif /* __CYGWIN__ */ - pthread_mutex_unlock(¬ifierMutex); + pthread_mutex_unlock(¬ifierMutex); #endif /* TCL_THREADS */ #else /* !NOTIFIER_SELECT */ - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; #if defined(NOTIFIER_EPOLL) && defined(HAVE_EVENTFD) - uint64_t eventFdVal = 1; - if (write(tsdPtr->triggerEventFd, &eventFdVal, - sizeof(eventFdVal)) != sizeof(eventFdVal)) { - Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerEventFd", - (void *)tsdPtr); - } + uint64_t eventFdVal = 1; + + if (write(tsdPtr->triggerEventFd, &eventFdVal, + sizeof(eventFdVal)) != sizeof(eventFdVal)) { + Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerEventFd", + (void *) tsdPtr); + } #else - if (write(tsdPtr->triggerPipe[1], "", 1) != 1) { - Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerPipe", - (void *)tsdPtr); - } + if (write(tsdPtr->triggerPipe[1], "", 1) != 1) { + Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerPipe", + (void *) tsdPtr); + } #endif /* NOTIFIER_EPOLL && HAVE_EVENTFD */ #endif /* NOTIFIER_SELECT */ +} + +/* + *---------------------------------------------------------------------- + * + * LookUpFileHandler -- + * + * Look up the file handler structure (and optionally the previous one in + * the chain) associated with a file descriptor. + * + * Returns: + * A pointer to the file handler, or NULL if it can't be found. + * + * Side effects: + * If prevPtrPtr is non-NULL, it will be written to if the file handler + * is found. + * + *---------------------------------------------------------------------- + */ + +static inline FileHandler * +LookUpFileHandler( + ThreadSpecificData *tsdPtr, /* Where to look things up. */ + int fd, /* What we are looking for. */ + FileHandler **prevPtrPtr) /* If non-NULL, where to report the previous + * pointer. */ +{ + FileHandler *filePtr, *prevPtr; + + /* + * Find the entry for the given file (and return if there isn't one). + */ + + for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; + prevPtr = filePtr, filePtr = filePtr->nextPtr) { + if (filePtr == NULL) { + return NULL; + } + if (filePtr->fd == fd) { + break; + } + } + + /* + * Report what we've found to our caller. + */ + + if (prevPtrPtr) { + *prevPtrPtr = prevPtr; } + return filePtr; } /* *---------------------------------------------------------------------- * - * Tcl_SetTimer -- + * TclpSetTimer -- * * This function sets the current notifier timer value. This interface is * not implemented in this notifier because we are always running inside @@ -158,19 +210,14 @@ Tcl_AlertNotifier( */ void -Tcl_SetTimer( +TclpSetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { - if (tclNotifierHooks.setTimerProc) { - tclNotifierHooks.setTimerProc(timePtr); - return; - } else { - /* - * The interval timer doesn't do anything in this implementation, - * because the only event loop is via Tcl_DoOneEvent, which passes - * timeout values to Tcl_WaitForEvent. - */ - } + /* + * The interval timer doesn't do anything in this implementation, because + * the only event loop is via Tcl_DoOneEvent, which passes timeout values + * to Tcl_WaitForEvent. + */ } /* @@ -190,14 +237,11 @@ Tcl_SetTimer( */ void -Tcl_ServiceModeHook( +TclpServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { - if (tclNotifierHooks.serviceModeHookProc) { - tclNotifierHooks.serviceModeHookProc(mode); - return; - } else if (mode == TCL_SERVICE_ALL) { + if (mode == TCL_SERVICE_ALL) { #ifdef NOTIFIER_SELECT #if TCL_THREADS StartNotifierThread("Tcl_ServiceModeHook"); @@ -414,12 +458,9 @@ AtForkChild(void) Tcl_InitNotifier(); } #endif /* HAVE_PTHREAD_ATFORK */ - #endif /* TCL_THREADS */ - #endif /* NOTIFIER_SELECT */ -#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is - * in tclMacOSXNotify.c */ + /* *---------------------------------------------------------------------- * @@ -443,6 +484,9 @@ AtForkChild(void) *---------------------------------------------------------------------- */ +#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is + * in tclMacOSXNotify.c */ + int TclUnixWaitForFile( int fd, /* Handle for file on which to wait. */ @@ -563,9 +607,8 @@ TclUnixWaitForFile( || (abortTime.sec == now.sec && abortTime.usec > now.usec)); return result; } - #endif /* !HAVE_COREFOUNDATION */ - + /* * Local Variables: * mode: c diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 990503d..94a666a 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -33,6 +33,23 @@ Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; void *tclTimeClientData = NULL; /* + * Inlined version of Tcl_GetTime. + */ + +static inline void +GetTime( + Tcl_Time *timePtr) +{ + tclGetTimeProcPtr(timePtr, tclTimeClientData); +} + +static inline int +IsTimeNative(void) +{ + return tclGetTimeProcPtr == NativeGetTime; +} + +/* *---------------------------------------------------------------------- * * TclpGetSeconds -- @@ -52,7 +69,7 @@ void *tclTimeClientData = NULL; unsigned long long TclpGetSeconds(void) { - return (unsigned long long)time(NULL); + return (unsigned long long) time(NULL); } /* @@ -77,8 +94,8 @@ TclpGetMicroseconds(void) { Tcl_Time time; - tclGetTimeProcPtr(&time, tclTimeClientData); - return ((long long)(unsigned long)time.sec)*1000000 + time.usec; + GetTime(&time); + return ((long long)(unsigned long) time.sec)*1000000 + time.usec; } /* @@ -106,25 +123,26 @@ TclpGetClicks(void) unsigned long long now; #ifdef NO_GETTOD - if (tclGetTimeProcPtr != NativeGetTime) { + if (!IsTimeNative()) { Tcl_Time time; - tclGetTimeProcPtr(&time, tclTimeClientData); - now = (unsigned long long)(unsigned long)time.sec*1000000 + time.usec; + GetTime(&time); + now = ((unsigned long long)(unsigned long) time.sec)*1000000 + + time.usec; } else { /* * A semi-NativeGetTime, specialized to clicks. */ struct tms dummy; - now = (unsigned long long)times(&dummy); + now = (unsigned long long) times(&dummy); } -#else +#else /* !NO_GETTOD */ Tcl_Time time; - tclGetTimeProcPtr(&time, tclTimeClientData); - now = (unsigned long long)time.sec*1000000 + time.usec; -#endif + GetTime(&time); + now = ((unsigned long long) time.sec)*1000000 + time.usec; +#endif /* NO_GETTOD */ return now; } @@ -154,17 +172,17 @@ TclpGetWideClicks(void) { long long now; - if (tclGetTimeProcPtr != NativeGetTime) { + if (!IsTimeNative()) { Tcl_Time time; - tclGetTimeProcPtr(&time, tclTimeClientData); - now = ((long long)time.sec)*1000000 + time.usec; + GetTime(&time); + now = ((long long) time.sec)*1000000 + time.usec; } else { #ifdef MAC_OSX_TCL now = (long long) (mach_absolute_time() & INT64_MAX); #else #error Wide high-resolution clicks not implemented on this platform -#endif +#endif /* MAC_OSX_TCL */ } return now; @@ -193,7 +211,7 @@ TclpWideClicksToNanoseconds( { double nsec; - if (tclGetTimeProcPtr != NativeGetTime) { + if (!IsTimeNative()) { nsec = clicks * 1000; } else { #ifdef MAC_OSX_TCL @@ -211,7 +229,7 @@ TclpWideClicksToNanoseconds( } #else #error Wide high-resolution clicks not implemented on this platform -#endif +#endif /* MAC_OSX_TCL */ } return nsec; @@ -238,27 +256,25 @@ TclpWideClicksToNanoseconds( double TclpWideClickInMicrosec(void) { - if (tclGetTimeProcPtr != NativeGetTime) { + if (!IsTimeNative()) { return 1.0; } else { #ifdef MAC_OSX_TCL static int initialized = 0; static double scale = 0.0; - if (initialized) { - return scale; - } else { + if (!initialized) { mach_timebase_info_data_t tb; mach_timebase_info(&tb); /* value of tb.numer / tb.denom = 1 click in nanoseconds */ - scale = ((double)tb.numer) / tb.denom / 1000; + scale = ((double) tb.numer) / tb.denom / 1000; initialized = 1; - return scale; } + return scale; #else #error Wide high-resolution clicks not implemented on this platform -#endif +#endif /* MAC_OSX_TCL */ } } #endif /* TCL_WIDE_CLICKS */ @@ -287,7 +303,7 @@ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { - tclGetTimeProcPtr(timePtr, tclTimeClientData); + GetTime(timePtr); } /* diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index 677dcb9..61dc731 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -132,7 +132,7 @@ TclSetAppContext( * after initialization, so we panic. */ - Tcl_Panic("TclSetAppContext: multiple application contexts"); + Tcl_Panic("TclSetAppContext: multiple application contexts"); } } else { /* @@ -359,7 +359,7 @@ CreateFileHandler( } } if (filePtr == NULL) { - filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->read = 0; filePtr->write = 0; @@ -496,7 +496,7 @@ FileProc( int *fd, XtInputId *id) { - FileHandler *filePtr = (FileHandler *)clientData; + FileHandler *filePtr = (FileHandler *) clientData; FileHandlerEvent *fileEvPtr; int mask = 0; @@ -525,7 +525,7 @@ FileProc( */ filePtr->readyMask |= mask; - fileEvPtr = (FileHandlerEvent *)Tcl_Alloc(sizeof(FileHandlerEvent)); + fileEvPtr = (FileHandlerEvent *) Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index c30dda8..db75237 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -77,65 +77,62 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, */ ClientData -Tcl_InitNotifier(void) +TclpInitNotifier(void) { - if (tclNotifierHooks.initNotifierProc) { - return tclNotifierHooks.initNotifierProc(); - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - TclpGlobalLock(); - if (!initialized) { - initialized = 1; - InitializeCriticalSection(¬ifierMutex); - } - TclpGlobalUnlock(); + TclpGlobalLock(); + if (!initialized) { + initialized = 1; + InitializeCriticalSection(¬ifierMutex); + } + TclpGlobalUnlock(); - /* - * Register Notifier window class if this is the first thread to use - * this module. - */ + /* + * Register Notifier window class if this is the first thread to use this + * module. + */ - EnterCriticalSection(¬ifierMutex); - if (notifierCount == 0) { - WNDCLASSW clazz; - - clazz.style = 0; - clazz.cbClsExtra = 0; - clazz.cbWndExtra = 0; - clazz.hInstance = (HINSTANCE)TclWinGetTclInstance(); - clazz.hbrBackground = NULL; - clazz.lpszMenuName = NULL; - clazz.lpszClassName = className; - clazz.lpfnWndProc = NotifierProc; - clazz.hIcon = NULL; - clazz.hCursor = NULL; - - if (!RegisterClassW(&clazz)) { - Tcl_Panic("Unable to register TclNotifier window class"); - } + EnterCriticalSection(¬ifierMutex); + if (notifierCount == 0) { + WNDCLASSW clazz; + + clazz.style = 0; + clazz.cbClsExtra = 0; + clazz.cbWndExtra = 0; + clazz.hInstance = (HINSTANCE) TclWinGetTclInstance(); + clazz.hbrBackground = NULL; + clazz.lpszMenuName = NULL; + clazz.lpszClassName = className; + clazz.lpfnWndProc = NotifierProc; + clazz.hIcon = NULL; + clazz.hCursor = NULL; + + if (!RegisterClassW(&clazz)) { + Tcl_Panic("Tcl_InitNotifier: %s", + "unable to register TclNotifier window class"); } - notifierCount++; - LeaveCriticalSection(¬ifierMutex); + } + notifierCount++; + LeaveCriticalSection(¬ifierMutex); - tsdPtr->pending = 0; - tsdPtr->timerActive = 0; + tsdPtr->pending = 0; + tsdPtr->timerActive = 0; - InitializeCriticalSection(&tsdPtr->crit); + InitializeCriticalSection(&tsdPtr->crit); - tsdPtr->hwnd = NULL; - tsdPtr->thread = GetCurrentThreadId(); - tsdPtr->event = CreateEventW(NULL, TRUE /* manual */, - FALSE /* !signaled */, NULL); + tsdPtr->hwnd = NULL; + tsdPtr->thread = GetCurrentThreadId(); + tsdPtr->event = CreateEventW(NULL, TRUE /* manual */, + FALSE /* !signaled */, NULL); - return tsdPtr; - } + return tsdPtr; } /* *---------------------------------------------------------------------- * - * Tcl_FinalizeNotifier -- + * TclpFinalizeNotifier -- * * This function is called to cleanup the notifier state before a thread * is terminated. @@ -150,62 +147,57 @@ Tcl_InitNotifier(void) */ void -Tcl_FinalizeNotifier( +TclpFinalizeNotifier( ClientData clientData) /* Pointer to notifier data. */ { - if (tclNotifierHooks.finalizeNotifierProc) { - tclNotifierHooks.finalizeNotifierProc(clientData); - return; - } else { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; - /* - * Only finalize the notifier if a notifier was installed in the - * current thread; there is a route in which this is not guaranteed to - * be true (when tclWin32Dll.c:DllMain() is called with the flag - * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread - * that's never previously been involved with Tcl, e.g. the task - * manager) so this check is important. - * - * Fixes Bug #217982 reported by Hugh Vu and Gene Leache. - */ + /* + * Only finalize the notifier if a notifier was installed in the current + * thread; there is a route in which this is not guaranteed to be true + * (when tclWin32Dll.c:DllMain() is called with the flag + * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread + * that's never previously been involved with Tcl, e.g. the task manager) + * so this check is important. + * + * Fixes Bug #217982 reported by Hugh Vu and Gene Leache. + */ - if (tsdPtr == NULL) { - return; - } + if (tsdPtr == NULL) { + return; + } - DeleteCriticalSection(&tsdPtr->crit); - CloseHandle(tsdPtr->event); + DeleteCriticalSection(&tsdPtr->crit); + CloseHandle(tsdPtr->event); - /* - * Clean up the timer and messaging window for this thread. - */ + /* + * Clean up the timer and messaging window for this thread. + */ - if (tsdPtr->hwnd) { - KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); - DestroyWindow(tsdPtr->hwnd); - } + if (tsdPtr->hwnd) { + KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); + DestroyWindow(tsdPtr->hwnd); + } - /* - * If this is the last thread to use the notifier, unregister the - * notifier window class. - */ + /* + * If this is the last thread to use the notifier, unregister the notifier + * window class. + */ - EnterCriticalSection(¬ifierMutex); - if (notifierCount) { - notifierCount--; - if (notifierCount == 0) { - UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance()); - } + EnterCriticalSection(¬ifierMutex); + if (notifierCount) { + notifierCount--; + if (notifierCount == 0) { + UnregisterClassW(className, (HINSTANCE) TclWinGetTclInstance()); } - LeaveCriticalSection(¬ifierMutex); } + LeaveCriticalSection(¬ifierMutex); } /* *---------------------------------------------------------------------- * - * Tcl_AlertNotifier -- + * TclpAlertNotifier -- * * Wake up the specified notifier from any thread. This routine is called * by the platform independent notifier code whenever the Tcl_ThreadAlert @@ -225,42 +217,37 @@ Tcl_FinalizeNotifier( */ void -Tcl_AlertNotifier( +TclpAlertNotifier( ClientData clientData) /* Pointer to thread data. */ { - if (tclNotifierHooks.alertNotifierProc) { - tclNotifierHooks.alertNotifierProc(clientData); - return; - } else { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; + /* + * Note that we do not need to lock around access to the hwnd because the + * race condition has no effect since any race condition implies that the + * notifier thread is already awake. + */ + + if (tsdPtr->hwnd) { /* - * Note that we do not need to lock around access to the hwnd because - * the race condition has no effect since any race condition implies - * that the notifier thread is already awake. + * We do need to lock around access to the pending flag. */ - if (tsdPtr->hwnd) { - /* - * We do need to lock around access to the pending flag. - */ - - EnterCriticalSection(&tsdPtr->crit); - if (!tsdPtr->pending) { - PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0); - } - tsdPtr->pending = 1; - LeaveCriticalSection(&tsdPtr->crit); - } else { - SetEvent(tsdPtr->event); + EnterCriticalSection(&tsdPtr->crit); + if (!tsdPtr->pending) { + PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0); } + tsdPtr->pending = 1; + LeaveCriticalSection(&tsdPtr->crit); + } else { + SetEvent(tsdPtr->event); } } /* *---------------------------------------------------------------------- * - * Tcl_SetTimer -- + * TclpSetTimer -- * * This procedure sets the current notifier timer value. The notifier * will ensure that Tcl_ServiceAll() is called after the specified @@ -276,54 +263,49 @@ Tcl_AlertNotifier( */ void -Tcl_SetTimer( +TclpSetTimer( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - if (tclNotifierHooks.setTimerProc) { - tclNotifierHooks.setTimerProc(timePtr); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + UINT timeout; + + /* + * We only need to set up an interval timer if we're being called from an + * external event loop. If we don't have a window handle then we just + * return immediately and let Tcl_WaitForEvent handle timeouts. + */ + + if (!tsdPtr->hwnd) { return; - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - UINT timeout; + } + if (!timePtr) { + timeout = 0; + } else { /* - * We only need to set up an interval timer if we're being called from - * an external event loop. If we don't have a window handle then we - * just return immediately and let Tcl_WaitForEvent handle timeouts. + * Make sure we pass a non-zero value into the timeout argument. + * Windows seems to get confused by zero length timers. */ - if (!tsdPtr->hwnd) { - return; + timeout = timePtr->sec * 1000 + timePtr->usec / 1000; + if (timeout == 0) { + timeout = 1; } + } - if (!timePtr) { - timeout = 0; - } else { - /* - * Make sure we pass a non-zero value into the timeout argument. - * Windows seems to get confused by zero length timers. - */ - - timeout = timePtr->sec * 1000 + timePtr->usec / 1000; - if (timeout == 0) { - timeout = 1; - } - } - if (timeout != 0) { - tsdPtr->timerActive = 1; - SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, - timeout, NULL); - } else { - tsdPtr->timerActive = 0; - KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); - } + if (timeout != 0) { + tsdPtr->timerActive = 1; + SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, timeout, NULL); + } else { + tsdPtr->timerActive = 0; + KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); } } /* *---------------------------------------------------------------------- * - * Tcl_ServiceModeHook -- + * TclpServiceModeHook -- * * This function is invoked whenever the service mode changes. * @@ -338,40 +320,34 @@ Tcl_SetTimer( */ void -Tcl_ServiceModeHook( +TclpServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { - if (tclNotifierHooks.serviceModeHookProc) { - tclNotifierHooks.serviceModeHookProc(mode); - return; - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - /* - * If this is the first time that the notifier has been used from a - * modal loop, then create a communication window. Note that after this - * point, the application needs to service events in a timely fashion - * or Windows will hang waiting for the window to respond to - * synchronous system messages. At some point, we may want to consider - * destroying the window if we leave the modal loop, but for now we'll - * leave it around. - */ + /* + * If this is the first time that the notifier has been used from a modal + * loop, then create a communication window. Note that after this point, + * the application needs to service events in a timely fashion or Windows + * will hang waiting for the window to respond to synchronous system + * messages. At some point, we may want to consider destroying the window + * if we leave the modal loop, but for now we'll leave it around. + */ - if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { - tsdPtr->hwnd = CreateWindowW(className, className, - WS_TILED, 0, 0, 0, 0, NULL, NULL, (HINSTANCE)TclWinGetTclInstance(), - NULL); + if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { + tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, + 0, 0, 0, 0, NULL, NULL, (HINSTANCE) TclWinGetTclInstance(), + NULL); - /* - * Send an initial message to the window to ensure that we wake up - * the notifier once we get into the modal loop. This will force - * the notifier to recompute the timeout value and schedule a timer - * if one is needed. - */ + /* + * Send an initial message to the window to ensure that we wake up the + * notifier once we get into the modal loop. This will force the + * notifier to recompute the timeout value and schedule a timer if one + * is needed. + */ - Tcl_AlertNotifier(tsdPtr); - } + Tcl_AlertNotifier(tsdPtr); } } @@ -421,7 +397,7 @@ NotifierProc( /* *---------------------------------------------------------------------- * - * Tcl_WaitForEvent -- + * TclpWaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on * the message queue. If the block time is 0, then Tcl_WaitForEvent just @@ -438,103 +414,99 @@ NotifierProc( */ int -Tcl_WaitForEvent( +TclpWaitForEvent( const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - if (tclNotifierHooks.waitForEventProc) { - return tclNotifierHooks.waitForEventProc(timePtr); - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - MSG msg; - DWORD timeout, result; - int status; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + MSG msg; + DWORD timeout, result; + int status; + /* + * Compute the timeout in milliseconds. + */ + + if (timePtr) { /* - * Compute the timeout in milliseconds. + * TIP #233 (Virtualized Time). Convert virtual domain delay to + * real-time. */ - if (timePtr) { - /* - * TIP #233 (Virtualized Time). Convert virtual domain delay to - * real-time. - */ + Tcl_Time myTime; - Tcl_Time myTime; + myTime.sec = timePtr->sec; + myTime.usec = timePtr->usec; - myTime.sec = timePtr->sec; - myTime.usec = timePtr->usec; + if (myTime.sec != 0 || myTime.usec != 0) { + TclScaleTime(&myTime); + } - if (myTime.sec != 0 || myTime.usec != 0) { - tclScaleTimeProcPtr(&myTime, tclTimeClientData); - } + timeout = myTime.sec * 1000 + myTime.usec / 1000; + } else { + timeout = INFINITE; + } - timeout = myTime.sec * 1000 + myTime.usec / 1000; - } else { - timeout = INFINITE; - } + /* + * Check to see if there are any messages in the queue before waiting + * because MsgWaitForMultipleObjects will not wake up if there are events + * currently sitting in the queue. + */ + if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* - * Check to see if there are any messages in the queue before waiting - * because MsgWaitForMultipleObjects will not wake up if there are - * events currently sitting in the queue. + * Wait for something to happen (a signal from another thread, a + * message, or timeout) or loop servicing asynchronous procedure calls + * queued to this thread. */ - if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { - /* - * Wait for something to happen (a signal from another thread, a - * message, or timeout) or loop servicing asynchronous procedure - * calls queued to this thread. - */ - - again: + do { result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout, QS_ALLINPUT, MWMO_ALERTABLE); - if (result == WAIT_IO_COMPLETION) { - goto again; - } else if (result == WAIT_FAILED) { - status = -1; - goto end; - } + } while (result == WAIT_IO_COMPLETION); + + if (result == WAIT_FAILED) { + status = -1; + goto end; } + } + + /* + * Check to see if there are any messages to process. + */ + if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* - * Check to see if there are any messages to process. + * Retrieve and dispatch the first message. */ - if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { + result = GetMessageW(&msg, NULL, 0, 0); + if (result == 0) { /* - * Retrieve and dispatch the first message. + * We received a request to exit this thread (WM_QUIT), so + * propagate the quit message and start unwinding. */ - result = GetMessageW(&msg, NULL, 0, 0); - if (result == 0) { - /* - * We received a request to exit this thread (WM_QUIT), so - * propagate the quit message and start unwinding. - */ - - PostQuitMessage((int) msg.wParam); - status = -1; - } else if (result == (DWORD)-1) { - /* - * We got an error from the system. I have no idea why this - * would happen, so we'll just unwind. - */ - - status = -1; - } else { - TranslateMessage(&msg); - DispatchMessageW(&msg); - status = 1; - } + PostQuitMessage((int) msg.wParam); + status = -1; + } else if (result == (DWORD) -1) { + /* + * We got an error from the system. I have no idea why this would + * happen, so we'll just unwind. + */ + + status = -1; } else { - status = 0; + TranslateMessage(&msg); + DispatchMessageW(&msg); + status = 1; } - - end: - ResetEvent(tsdPtr->event); - return status; + } else { + status = 0; } + + end: + ResetEvent(tsdPtr->event); + return status; } /* @@ -588,7 +560,7 @@ Tcl_Sleep( * TIP #233: Scale delay from virtual to real-time. */ - tclScaleTimeProcPtr(&vdelay, tclTimeClientData); + TclScaleTime(&vdelay); sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; for (;;) { @@ -603,12 +575,52 @@ Tcl_Sleep( vdelay.sec = desired.sec - now.sec; vdelay.usec = desired.usec - now.usec; - tclScaleTimeProcPtr(&vdelay, tclTimeClientData); + TclScaleTime(&vdelay); sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; } } /* + *---------------------------------------------------------------------- + * + * TclpCreateFileHandler, TclpDeleteFileHandler -- + * + * Stub functions for strictly POSIX-only functionality that panic with a + * failure message; they simply don't work at all on Windows so using + * them on the platform is always a programming bug. + * + * Results: + * None. + * + * Side effects: + * The process will terminate, violently. + * + *---------------------------------------------------------------------- + */ + +void +TclpCreateFileHandler( + int fd, /* Handle of stream to watch. */ + int mask, /* OR'ed combination of TCL_READABLE, + * TCL_WRITABLE, and TCL_EXCEPTION: indicates + * conditions under which proc should be + * called. */ + Tcl_FileProc *proc, /* Function to call for each selected + * event. */ + ClientData clientData) /* Arbitrary data to pass to proc. */ +{ + Tcl_Panic("Tcl_CreateFileHandler not supported on this platform"); +} + +void +Tcl_DeleteFileHandler( + int fd) /* Stream id for which to remove callback + * function. */ +{ + Tcl_Panic("Tcl_DeleteFileHandler not supported on this platform"); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 0bd5b7e..6de8944 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -28,7 +28,8 @@ typedef struct { * initialized. */ int perfCounterAvailable; /* Flag == 1 if the hardware has a performance * counter. */ - DWORD calibrationInterv; /* Calibration interval in seconds (start 1 sec) */ + DWORD calibrationInterv; /* Calibration interval in seconds (start 1 + * sec) */ HANDLE calibrationThread; /* Handle to the thread that keeps the virtual * clock calibrated. */ HANDLE readyEvent; /* System event used to trigger the requesting @@ -97,7 +98,8 @@ static TimeInfo timeInfo = { */ static struct { int initialized; /* 1 if initialized, 0 otherwise */ - int perfCounter; /* 1 if performance counter usable for wide clicks */ + int perfCounter; /* 1 if performance counter usable for wide + * clicks */ double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; @@ -128,6 +130,23 @@ Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; ClientData tclTimeClientData = NULL; /* + * Inlined version of Tcl_GetTime. + */ + +static inline void +GetTime( + Tcl_Time *timePtr) +{ + tclGetTimeProcPtr(timePtr, tclTimeClientData); +} + +static inline int +IsTimeNative(void) +{ + return tclGetTimeProcPtr == NativeGetTime; +} + +/* *---------------------------------------------------------------------- * * TclpGetSeconds -- @@ -149,16 +168,17 @@ TclpGetSeconds(void) { long long usecSincePosixEpoch; - /* Try to use high resolution timer */ - if ( tclGetTimeProcPtr == NativeGetTime - && (usecSincePosixEpoch = NativeGetMicroseconds()) - ) { + /* + * Try to use high resolution timer + */ + + if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { return usecSincePosixEpoch / 1000000; } else { Tcl_Time t; - tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */ - return (unsigned long long)(unsigned long)t.sec; + GetTime(&t); + return (unsigned long long)(unsigned long) t.sec; } } @@ -186,11 +206,12 @@ TclpGetClicks(void) { long long usecSincePosixEpoch; - /* Try to use high resolution timer */ - if ( tclGetTimeProcPtr == NativeGetTime - && (usecSincePosixEpoch = NativeGetMicroseconds()) - ) { - return (Tcl_WideUInt)usecSincePosixEpoch; + /* + * Try to use high resolution timer. + */ + + if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { + return (Tcl_WideUInt) usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as @@ -199,8 +220,9 @@ TclpGetClicks(void) Tcl_Time now; /* Current Tcl time */ - tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ - return ((unsigned long long)(unsigned long)now.sec * 1000000ULL) + now.usec; + GetTime(&now); + return ((unsigned long long)(unsigned long) now.sec * 1000000ULL) + + now.usec; } } @@ -236,6 +258,7 @@ TclpGetWideClicks(void) * is consistent across all processors. Therefore, the frequency need * only be queried upon application initialization. */ + if (QueryPerformanceFrequency(&perfCounterFreq)) { wideClick.perfCounter = 1; wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart; @@ -282,7 +305,7 @@ double TclpWideClickInMicrosec(void) { if (!wideClick.initialized) { - (void)TclpGetWideClicks(); /* initialize */ + (void) TclpGetWideClicks(); /* initialize */ } return wideClick.microsecsScale; } @@ -309,21 +332,22 @@ TclpGetMicroseconds(void) { long long usecSincePosixEpoch; - /* Try to use high resolution timer */ - if ( tclGetTimeProcPtr == NativeGetTime - && (usecSincePosixEpoch = NativeGetMicroseconds()) - ) { + /* + * Try to use high resolution timer. + */ + + if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { return usecSincePosixEpoch; } else { /* - * Use the Tcl_GetTime abstraction to get the time in microseconds, as - * nearly as we can, and return it. - */ + * Use the Tcl_GetTime abstraction to get the time in microseconds, as + * nearly as we can, and return it. + */ Tcl_Time now; - tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ - return (((long long)now.sec) * 1000000) + now.usec; + GetTime(&now); + return (((long long) now.sec) * 1000000) + now.usec; } } @@ -355,14 +379,15 @@ Tcl_GetTime( { long long usecSincePosixEpoch; - /* Try to use high resolution timer */ - if ( tclGetTimeProcPtr == NativeGetTime - && (usecSincePosixEpoch = NativeGetMicroseconds()) - ) { + /* + * Try to use high resolution timer. + */ + + if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { timePtr->sec = (long) (usecSincePosixEpoch / 1000000); timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); } else { - tclGetTimeProcPtr(timePtr, tclTimeClientData); + GetTime(timePtr); } } @@ -396,6 +421,96 @@ NativeScaleTime( /* *---------------------------------------------------------------------- * + * IsPerfCounterAvailable -- + * + * Tests whether the performance counter is available, which is a gnarly + * problem on 32-bit systems. Also retrieves the nominal frequency of the + * performance counter. + * + * Results: + * 1 if the counter is available, 0 if not. + * + * Side effects: + * Updates fields of the timeInfo global. Make sure you hold the lock + * before calling this. + * + *---------------------------------------------------------------------- + */ + +static inline int +IsPerfCounterAvailable(void) +{ + timeInfo.perfCounterAvailable = + QueryPerformanceFrequency(&timeInfo.nominalFreq); + + /* + * Some hardware abstraction layers use the CPU clock in place of the + * real-time clock as a performance counter reference. This results in: + * - inconsistent results among the processors on multi-processor + * systems. + * - unpredictable changes in performance counter frequency on + * "gearshift" processors such as Transmeta and SpeedStep. + * + * There seems to be no way to test whether the performance counter is + * reliable, but a useful heuristic is that if its frequency is 1.193182 + * MHz or 3.579545 MHz, it's derived from a colorburst crystal and is + * therefore the RTC rather than the TSC. + * + * A sloppier but serviceable heuristic is that the RTC crystal is + * normally less than 15 MHz while the TSC crystal is virtually assured to + * be greater than 100 MHz. Since Win98SE appears to fiddle with the + * definition of the perf counter frequency (perhaps in an attempt to + * calibrate the clock?), we use the latter rule rather than an exact + * match. + * + * We also assume (perhaps questionably) that the vendors have gotten + * their act together on Win64, so bypass all this rubbish on that + * platform. + */ + +#if !defined(_WIN64) + if (timeInfo.perfCounterAvailable && + /* + * The following lines would do an exact match on crystal + * frequency: + * + * timeInfo.nominalFreq.QuadPart != (long long) 1193182 && + * timeInfo.nominalFreq.QuadPart != (long long) 3579545 && + */ + timeInfo.nominalFreq.QuadPart > (long long) 15000000) { + /* + * As an exception, if every logical processor on the system is on the + * same chip, we use the performance counter anyway, presuming that + * everyone's TSC is locked to the same oscillator. + */ + + SYSTEM_INFO systemInfo; + int regs[4]; + + GetSystemInfo(&systemInfo); + if (TclWinCPUID(0, regs) == TCL_OK + && regs[1] == 0x756E6547 /* "Genu" */ + && regs[3] == 0x49656E69 /* "ineI" */ + && regs[2] == 0x6C65746E /* "ntel" */ + && TclWinCPUID(1, regs) == TCL_OK + && ((regs[0]&0x00000F00) == 0x00000F00 /* Pentium 4 */ + || ((regs[0] & 0x00F00000) /* Extended family */ + && (regs[3] & 0x10000000))) /* Hyperthread */ + && (((regs[1]&0x00FF0000) >> 16)/* CPU count */ + == (int)sy stemInfo.dwNumberOfProcessors)) { + timeInfo.perfCounterAvailable = TRUE; + } else { + timeInfo.perfCounterAvailable = FALSE; + } + } +#endif /* above code is Win32 only */ + + return timeInfo.perfCounterAvailable; +} + +/* + *---------------------------------------------------------------------- + * * NativeGetMicroseconds -- * * Gets the current system time in microseconds since the beginning @@ -421,10 +536,10 @@ NativeCalc100NsTicks( ULONGLONG fileTimeLastCall, LONGLONG perfCounterLastCall, LONGLONG curCounterFreq, - LONGLONG curCounter -) { + LONGLONG curCounter) +{ return fileTimeLastCall + - ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq); + ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq); } static long long @@ -440,83 +555,15 @@ NativeGetMicroseconds(void) if (!timeInfo.initialized) { TclpInitLock(); if (!timeInfo.initialized) { - timeInfo.posixEpoch.LowPart = 0xD53E8000; timeInfo.posixEpoch.HighPart = 0x019DB1DE; - timeInfo.perfCounterAvailable = - QueryPerformanceFrequency(&timeInfo.nominalFreq); - - /* - * Some hardware abstraction layers use the CPU clock in place of - * the real-time clock as a performance counter reference. This - * results in: - * - inconsistent results among the processors on - * multi-processor systems. - * - unpredictable changes in performance counter frequency on - * "gearshift" processors such as Transmeta and SpeedStep. - * - * There seems to be no way to test whether the performance - * counter is reliable, but a useful heuristic is that if its - * frequency is 1.193182 MHz or 3.579545 MHz, it's derived from a - * colorburst crystal and is therefore the RTC rather than the - * TSC. - * - * A sloppier but serviceable heuristic is that the RTC crystal is - * normally less than 15 MHz while the TSC crystal is virtually - * assured to be greater than 100 MHz. Since Win98SE appears to - * fiddle with the definition of the perf counter frequency - * (perhaps in an attempt to calibrate the clock?), we use the - * latter rule rather than an exact match. - * - * We also assume (perhaps questionably) that the vendors have - * gotten their act together on Win64, so bypass all this rubbish - * on that platform. - */ - -#if !defined(_WIN64) - if (timeInfo.perfCounterAvailable - /* - * The following lines would do an exact match on crystal - * frequency: - * && timeInfo.nominalFreq.QuadPart != (long long)1193182 - * && timeInfo.nominalFreq.QuadPart != (long long)3579545 - */ - && timeInfo.nominalFreq.QuadPart > (long long) 15000000){ - /* - * As an exception, if every logical processor on the system - * is on the same chip, we use the performance counter anyway, - * presuming that everyone's TSC is locked to the same - * oscillator. - */ - - SYSTEM_INFO systemInfo; - int regs[4]; - - GetSystemInfo(&systemInfo); - if (TclWinCPUID(0, regs) == TCL_OK - && regs[1] == 0x756E6547 /* "Genu" */ - && regs[3] == 0x49656E69 /* "ineI" */ - && regs[2] == 0x6C65746E /* "ntel" */ - && TclWinCPUID(1, regs) == TCL_OK - && ((regs[0]&0x00000F00) == 0x00000F00 /* Pentium 4 */ - || ((regs[0] & 0x00F00000) /* Extended family */ - && (regs[3] & 0x10000000))) /* Hyperthread */ - && (((regs[1]&0x00FF0000) >> 16)/* CPU count */ - == (int)systemInfo.dwNumberOfProcessors)) { - timeInfo.perfCounterAvailable = TRUE; - } else { - timeInfo.perfCounterAvailable = FALSE; - } - } -#endif /* above code is Win32 only */ - /* * If the performance counter is available, start a thread to * calibrate it. */ - if (timeInfo.perfCounterAvailable) { + if (IsPerfCounterAvailable()) { DWORD id; InitializeCriticalSection(&timeInfo.cs); @@ -550,8 +597,8 @@ NativeGetMicroseconds(void) ULONGLONG fileTimeLastCall; LONGLONG perfCounterLastCall, curCounterFreq; - /* Copy with current data of calibration cycle */ - + /* Copy with current data of calibration + * cycle. */ LARGE_INTEGER curCounter; /* Current performance counter. */ @@ -560,6 +607,7 @@ NativeGetMicroseconds(void) /* * Hold time section locked as short as possible */ + EnterCriticalSection(&timeInfo.cs); fileTimeLastCall = timeInfo.fileTimeLastCall.QuadPart; @@ -571,8 +619,12 @@ NativeGetMicroseconds(void) /* * If calibration cycle occurred after we get curCounter */ + if (curCounter.QuadPart <= perfCounterLastCall) { - /* Calibrated file-time is saved from posix in 100-ns ticks */ + /* + * Calibrated file-time is saved from posix in 100-ns ticks + */ + return fileTimeLastCall / 10; } @@ -587,17 +639,21 @@ NativeGetMicroseconds(void) */ if (curCounter.QuadPart - perfCounterLastCall < - 11 * curCounterFreq * timeInfo.calibrationInterv / 10 - ) { - /* Calibrated file-time is saved from posix in 100-ns ticks */ + 11 * curCounterFreq * timeInfo.calibrationInterv / 10) { + /* + * Calibrated file-time is saved from posix in 100-ns ticks. + */ + return NativeCalc100NsTicks(fileTimeLastCall, - perfCounterLastCall, curCounterFreq, curCounter.QuadPart) / 10; + perfCounterLastCall, curCounterFreq, + curCounter.QuadPart) / 10; } } /* * High resolution timer is not available. */ + return 0; } @@ -628,18 +684,20 @@ NativeGetTime( /* * Try to use high resolution timer. */ - if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) { + + usecSincePosixEpoch = NativeGetMicroseconds(); + if (usecSincePosixEpoch) { timePtr->sec = (long) (usecSincePosixEpoch / 1000000); timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); } else { /* - * High resolution timer is not available. Just use ftime. - */ + * High resolution timer is not available. Just use ftime. + */ struct _timeb t; _ftime(&t); - timePtr->sec = (long)t.time; + timePtr->sec = (long) t.time; timePtr->usec = t.millitm * 1000; } } @@ -722,7 +780,11 @@ CalibrationThread( QueryPerformanceFrequency(&timeInfo.curCounterFreq); timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime; timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; - /* Calibrated file-time will be saved from posix in 100-ns ticks */ + + /* + * Calibrated file-time will be saved from posix in 100-ns ticks. + */ + timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart; ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart, @@ -782,10 +844,11 @@ UpdateTimeEachSecond(void) /* Current value returned from * QueryPerformanceCounter. */ FILETIME curSysTime; /* Current system time. */ - static LARGE_INTEGER lastFileTime; /* File time of the previous calibration */ + static LARGE_INTEGER lastFileTime; + /* File time of the previous calibration */ LARGE_INTEGER curFileTime; /* File time at the time this callback was * scheduled. */ - long long estFreq; /* Estimated perf counter frequency. */ + long long estFreq; /* Estimated perf counter frequency. */ long long vt0; /* Tcl time right now. */ long long vt1; /* Tcl time one second from now. */ long long tdiff; /* Difference between system clock and Tcl @@ -801,12 +864,17 @@ UpdateTimeEachSecond(void) curFileTime.LowPart = curSysTime.dwLowDateTime; curFileTime.HighPart = curSysTime.dwHighDateTime; curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart; - /* If calibration still not needed (check for possible time switch) */ - if ( curFileTime.QuadPart > lastFileTime.QuadPart - && curFileTime.QuadPart < lastFileTime.QuadPart + - (timeInfo.calibrationInterv * 10000000) - ) { - /* again in next one second */ + + /* + * If calibration still not needed (check for possible time switch) + */ + + if (curFileTime.QuadPart > lastFileTime.QuadPart && curFileTime.QuadPart < + lastFileTime.QuadPart + (timeInfo.calibrationInterv * 10000000)) { + /* + * Look again in next one second. + */ + return; } QueryPerformanceCounter(&curPerfCounter); @@ -862,8 +930,9 @@ UpdateTimeEachSecond(void) */ vt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, - timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, - curPerfCounter.QuadPart); + timeInfo.perfCounterLastCall.QuadPart, + timeInfo.curCounterFreq.QuadPart, curPerfCounter.QuadPart); + /* * If we've gotten more than a second away from system time, then drifting * the clock is going to be pretty hopeless. Just let it jump. Otherwise, @@ -872,17 +941,25 @@ UpdateTimeEachSecond(void) tdiff = vt0 - curFileTime.QuadPart; if (tdiff > 10000000 || tdiff < -10000000) { - /* jump to current system time, use curent estimated frequency */ + /* + * Jump to current system time, use curent estimated frequency. + */ + vt0 = curFileTime.QuadPart; } else { - /* calculate new frequency and estimate drift to the next second */ + /* + * Calculate new frequency and estimate drift to the next second. + */ + vt1 = 20000000 + curFileTime.QuadPart; driftFreq = (estFreq * 20000000 / (vt1 - vt0)); + /* - * Avoid too large drifts (only half of the current difference), - * that allows also be more accurate (aspire to the smallest tdiff), - * so then we can prolong calibration interval by tdiff < 100000 + * Avoid too large drifts (only half of the current difference), that + * allows also be more accurate (aspire to the smallest tdiff), so + * then we can prolong calibration interval by tdiff < 100000 */ + driftFreq = timeInfo.curCounterFreq.QuadPart + (driftFreq - timeInfo.curCounterFreq.QuadPart) / 2; @@ -890,50 +967,79 @@ UpdateTimeEachSecond(void) * Average between estimated, 2 current and 5 drifted frequencies, * (do the soft drifting as possible) */ - estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + 5 * driftFreq) / 8; + + estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + + 5 * driftFreq) / 8; } - /* Avoid too large discrepancy from nominal frequency */ - if (estFreq > 1003*timeInfo.nominalFreq.QuadPart/1000) { - estFreq = 1003*timeInfo.nominalFreq.QuadPart/1000; + /* + * Avoid too large discrepancy from nominal frequency. + */ + + if (estFreq > 1003 * timeInfo.nominalFreq.QuadPart / 1000) { + estFreq = 1003 * timeInfo.nominalFreq.QuadPart / 1000; vt0 = curFileTime.QuadPart; - } else if (estFreq < 997*timeInfo.nominalFreq.QuadPart/1000) { - estFreq = 997*timeInfo.nominalFreq.QuadPart/1000; + } else if (estFreq < 997 * timeInfo.nominalFreq.QuadPart / 1000) { + estFreq = 997 * timeInfo.nominalFreq.QuadPart / 1000; vt0 = curFileTime.QuadPart; } else if (vt0 != curFileTime.QuadPart) { /* - * Be sure the clock ticks never backwards (avoid it by negative drifting) - * just compare native time (in 100-ns) before and hereafter using - * new calibrated values) and do a small adjustment (short time freeze) + * Be sure the clock ticks never backwards (avoid it by negative + * drifting). Just compare native time (in 100-ns) before and + * hereafter using new calibrated values) and do a small adjustment + * (short time freeze). */ + LARGE_INTEGER newPerfCounter; long long nt0, nt1; QueryPerformanceCounter(&newPerfCounter); nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, - timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, - newPerfCounter.QuadPart); + timeInfo.perfCounterLastCall.QuadPart, + timeInfo.curCounterFreq.QuadPart, newPerfCounter.QuadPart); nt1 = NativeCalc100NsTicks(vt0, - curPerfCounter.QuadPart, estFreq, - newPerfCounter.QuadPart); - if (nt0 > nt1) { /* drifted backwards, try to compensate with new base */ - /* first adjust with a micro jump (short frozen time is acceptable) */ + curPerfCounter.QuadPart, estFreq, newPerfCounter.QuadPart); + if (nt0 > nt1) { + /* + * Drifted backwards, try to compensate with new base. + * + * First adjust with a micro jump (short frozen time is + * acceptable). + */ + vt0 += nt0 - nt1; - /* if drift unavoidable (e. g. we had a time switch), then reset it */ + + /* + * If drift unavoidable (e. g. we had a time switch), then reset + * it. + */ + vt1 = vt0 - curFileTime.QuadPart; if (vt1 > 10000000 || vt1 < -10000000) { - /* larger jump resp. shift relative new file-time */ + /* + * Larger jump resp. shift relative new file-time. + */ + vt0 = curFileTime.QuadPart; } } } - /* In lock commit new values to timeInfo (hold lock as short as possible) */ + /* + * In lock commit new values to timeInfo (hold lock as short as possible) + */ + EnterCriticalSection(&timeInfo.cs); - /* grow calibration interval up to 10 seconds (if still precise enough) */ + /* + * Grow calibration interval up to 10 seconds (if still precise enough) + */ + if (tdiff < -100000 || tdiff > 100000) { - /* too long drift - reset calibration interval to 1000 second */ + /* + * Too long drift. Reset calibration interval to 1000 second. + */ + timeInfo.calibrationInterv = 1; } else if (timeInfo.calibrationInterv < 10) { timeInfo.calibrationInterv++; @@ -967,12 +1073,13 @@ UpdateTimeEachSecond(void) static void ResetCounterSamples( - unsigned long long fileTime, /* Current file time */ + unsigned long long fileTime,/* Current file time */ long long perfCounter, /* Current performance counter */ - long long perfFreq) /* Target performance frequency */ + long long perfFreq) /* Target performance frequency */ { int i; - for (i=SAMPLES-1 ; i>=0 ; --i) { + + for (i = SAMPLES - 1 ; i >= 0 ; --i) { timeInfo.perfCounterSample[i] = perfCounter; timeInfo.fileTimeSample[i] = fileTime; perfCounter -= perfFreq; @@ -1012,15 +1119,17 @@ AccumulateSample( long long perfCounter, unsigned long long fileTime) { - unsigned long long workFTSample; /* File time sample being removed from or + unsigned long long workFTSample; + /* File time sample being removed from or * added to the circular buffer. */ long long workPCSample; /* Performance counter sample being removed * from or added to the circular buffer. */ - unsigned long long lastFTSample; /* Last file time sample recorded */ + unsigned long long lastFTSample; + /* Last file time sample recorded */ long long lastPCSample; /* Last performance counter sample recorded */ long long FTdiff; /* Difference between last FT and current */ long long PCdiff; /* Difference between last PC and current */ - long long estFreq; /* Estimated performance counter frequency */ + long long estFreq; /* Estimated performance counter frequency */ /* * Test for jumps and reset the samples if we have one. |