diff options
44 files changed, 411 insertions, 300 deletions
diff --git a/.travis.yml b/.travis.yml index 6133d8f..62fb2ba 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,6 +10,13 @@ matrix: compiler: gcc env: - BUILD_DIR=unix + - name: "Linux/GCC/Shared: UTF_MAX=3" + os: linux + dist: xenial + compiler: gcc + env: + - BUILD_DIR=unix + - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3" - name: "Linux/GCC/Shared: NO_DEPRECATED" os: linux dist: xenial @@ -281,6 +288,13 @@ matrix: before_install: &makepreinst - choco install -y make zip - cd ${BUILD_DIR} + - name: "Windows/GCC/Shared: UTF_MAX" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3" + before_install: *makepreinst - name: "Windows/GCC/Shared: NO_DEPRECATED" os: windows compiler: gcc @@ -309,6 +323,13 @@ matrix: env: - BUILD_DIR=win before_install: *makepreinst + - name: "Windows/GCC-x86/Shared: UTF_MAX=3" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3" + before_install: *makepreinst - name: "Windows/GCC-x86/Shared: NO_DEPRECATED" os: windows compiler: gcc diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index b987646..c113efb 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -648,8 +648,8 @@ It should call \fBTcl_BadChannelOption\fR which itself returns unrecognized. If \fInewValue\fR specifies a value for the option that is not supported or if a system call error occurs, -the function should leave an error message in the -\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The +the function should leave an error message in the result +of \fIinterp\fR if \fIinterp\fR is not NULL. The function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX error code. .PP diff --git a/doc/CrtSlave.3 b/doc/CrtSlave.3 index ac681bc..b8ac421 100644 --- a/doc/CrtSlave.3 +++ b/doc/CrtSlave.3 @@ -119,7 +119,7 @@ in a hierarchical relationship, and the management of aliases, commands that when invoked in one interpreter execute a command in another interpreter. The return value for those procedures that return an \fBint\fR is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned -then the \fBresult\fR field of the interpreter contains an error message. +then the interpreter's result contains an error message. .PP \fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR. It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which @@ -158,12 +158,12 @@ If no such slave interpreter exists, \fBNULL\fR is returned. \fIinterp\fR. If \fIinterp\fR has no master (it is a top-level interpreter) then \fBNULL\fR is returned. .PP -\fBTcl_GetInterpPath\fR sets the \fIresult\fR field in \fIaskingInterp\fR -to the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR; +\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR +the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR; \fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation of the relative path succeeds, \fBTCL_OK\fR is returned, else -\fBTCL_ERROR\fR is returned and the \fIresult\fR field in -\fIaskingInterp\fR contains the error message. +\fBTCL_ERROR\fR is returned and an error message is stored as the +result of \fIaskingInterp\fR. .PP \fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in \fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR @@ -198,33 +198,33 @@ the set of hidden commands to the set of exposed commands, putting it under the name \fIcmdName\fR. \fIHiddenCmdName\fR must be the name of an existing hidden -command, or the operation will return \fBTCL_ERROR\fR and leave an error -message in the \fIresult\fR field in \fIinterp\fR. +command, or the operation will return \fBTCL_ERROR\fR and +leave an error message as the result of \fIinterp\fR. If an exposed command named \fIcmdName\fR already exists, -the operation returns \fBTCL_ERROR\fR and leaves an error message in the -value result of \fIinterp\fR. +the operation returns \fBTCL_ERROR\fR and leaves an error message as +the result of \fIinterp\fR. If the operation succeeds, it returns \fBTCL_OK\fR. -After executing this command, attempts to use \fIcmdName\fR in a call to -\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will again succeed. +After executing this command, attempts to use \fIcmdName\fR in any +script evaluation mechanism will again succeed. .PP \fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of exposed commands to the set of hidden commands, under the name \fIhiddenCmdName\fR. \fICmdName\fR must be the name of an existing exposed command, or the operation will return \fBTCL_ERROR\fR and leave an error -message in the value result of \fIinterp\fR. +message as the result of \fIinterp\fR. Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and -leave an error message in the value result of \fIinterp\fR. +leave an error message as the result of \fIinterp\fR. The \fICmdName\fR will be looked up in the global namespace, and not relative to the current namespace, even if the current namespace is not the global one. If a hidden command whose name is \fIhiddenCmdName\fR already -exists, the operation also returns \fBTCL_ERROR\fR and the \fIresult\fR -field in \fIinterp\fR contains an error message. +exists, the operation also returns \fBTCL_ERROR\fR and an error +message is left as the result of \fIinterp\fR. If the operation succeeds, it returns \fBTCL_OK\fR. -After executing this command, attempts to use \fIcmdName\fR in a call to -\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will fail. +After executing this command, attempts to use \fIcmdName\fR in +any script evaluation mechanism will fail. .PP For a description of the Tcl interface to multiple interpreters, see \fIinterp(n)\fR. diff --git a/doc/Panic.3 b/doc/Panic.3 index d0c2a6d..fa45a30 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -50,13 +50,13 @@ In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted error message to the standard error file of the process, and then calls \fBabort\fR to terminate the process. \fBTcl_Panic\fR does not return. On Windows, when a debugger is running, the formatted error -message is sent to the debugger in stead. If the windows executable +message is sent to the debugger instead. If the windows executable does not have a stderr channel (e.g. \fBwish.exe\fR), then a system dialog box is used to display the panic message. .PP If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR and you want to implicitly use the stderr channel of your -application's C runtime (in stead of the stderr channel of the +application's C runtime (instead of the stderr channel of the C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR with \fBTcl_ConsolePanic\fR as its argument. On platforms which only have one C runtime (almost all platforms except Windows) @@ -83,13 +83,15 @@ The typical use of \fBTcl_SetPanicProc\fR arranges for the error message to be displayed or reported in a manner more suitable for the application or the platform. .PP +\fBTcl_SetPanicProc\fR can not be used safely by stub-enabled extensions, so its +symbol is not included in the stub table. +.PP Although the primary callers of \fBTcl_Panic\fR are the procedures of the Tcl library, \fBTcl_Panic\fR is a public function and may be called by any extension or application that wishes to abort the process and have a panic message displayed the same way that panic messages from Tcl will be displayed. .PP -This function can not be used in stub-enabled extensions. .SH "SEE ALSO" abort(3), printf(3), exec(n), format(n) .SH KEYWORDS diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3 index 6e7e94a..a28652e 100644 --- a/doc/StaticPkg.3 +++ b/doc/StaticPkg.3 @@ -65,7 +65,8 @@ error message. The result or error from the initialization procedure will be returned as the result of the \fBload\fR command that caused the initialization procedure to be invoked. .PP -This function can not be used in stub-enabled extensions. +\fBTcl_StaticPackage\fR can not be safely used by stub-enabled extensions, +so its symbol is not included in the stub table. .SH KEYWORDS initialization procedure, package, static linking .SH "SEE ALSO" diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3 index 816dfeb..dc4f45f 100644 --- a/doc/Tcl_Main.3 +++ b/doc/Tcl_Main.3 @@ -190,7 +190,7 @@ procedure (if any) returns. In non-interactive mode, after procedure (if any) returns, \fBTcl_Main\fR will also evaluate the \fBexit\fR command. .PP -This function can not be used in stub-enabled extensions. +\fBTcl_Main\fR can not be used in stub-enabled extensions. .SH "SEE ALSO" tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3), exit(n), encoding(n) @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_WCharToUtfDString, Tcl_UtfToWCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToChar16DString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings +Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -120,6 +120,12 @@ A null-terminated Unicode string. A null-terminated UTF-16 string. .AP "const wchar_t" *wStr in A null-terminated wchar_t string. +.AP "const unsigned short" *utf16s in +A null-terminated utf-16 string. +.AP "const unsigned short" *utf16t in +A null-terminated utf-16 string. +.AP "const unsigned short" *utf16Pattern in +A null-terminated utf-16 string. .AP size_t length in The length of the UTF-8 string in bytes (not UTF-8 characters). If negative, all bytes up to the first null byte are used. @@ -146,11 +152,11 @@ case-insensitive (1). .PP These routines convert between UTF-8 strings and Unicode/Utf-16 characters. A UTF-8 character is a Unicode character represented as a varying-length -sequence of up to \fBTCL_UTF_MAX\fR bytes. A multibyte UTF-8 sequence +sequence of up to \fB4\fR bytes. A multibyte UTF-8 sequence consists of a lead byte followed by some number of trail bytes. .PP -\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to -represent one Unicode character in the UTF-8 representation. +\fBTCL_UTF_MAX\fR is the maximum number of bytes that \fBTcl_UtfToUniChar\fR +can consume in a single call. .PP \fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string in starting at \fIbuf\fR. The return value is the number of bytes stored diff --git a/doc/zipfs.3 b/doc/zipfs.3 index 23b9a93..348557f 100644 --- a/doc/zipfs.3 +++ b/doc/zipfs.3 @@ -83,7 +83,7 @@ example, the Tcl 8.7.2 release would be searched for in a file \fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only. .PP On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since -it uses WCHAR in stead of char. As a result, it requires your application to +it uses WCHAR instead of char. As a result, it requires your application to be compiled with the UNICODE preprocessor symbol defined (e.g., via the \fB-DUNICODE\fR compiler flag). .PP diff --git a/generic/regcustom.h b/generic/regcustom.h index caa6cc9..8c86e49 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -84,7 +84,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */ #define NOCELT (-1) /* Celt value which is not valid chr */ #define CHR(c) (UCHAR(c)) /* Turn char literal into chr literal */ #define DIGITVAL(c) ((c)-'0') /* Turn chr digit into its value */ -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 #define CHRBITS 32 /* Bits in a chr; must not use sizeof */ #define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */ #define CHR_MAX 0x10ffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */ diff --git a/generic/tcl.decls b/generic/tcl.decls index f852601..5b3688a 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -155,7 +155,7 @@ declare 35 { double *doublePtr) } # Removed in 9.0, replaced by macro. -#declare 36 {deprecated {No longer in use, changed to macro}} { +#declare 36 { # int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, # const char *const *tablePtr, const char *msg, int flags, int *indexPtr) #} @@ -260,11 +260,11 @@ declare 65 { void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t length) } # Removed in 9.0, replaced by macro. -#declare 66 {deprecated {No longer in use, changed to macro}} { +#declare 66 { # void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) #} # Removed in 9.0, replaced by macro. -#declare 67 {deprecated {No longer in use, changed to macro}} { +#declare 67 { # void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, # int length) #} @@ -294,11 +294,11 @@ declare 75 { int Tcl_AsyncReady(void) } # Removed in 9.0 -#declare 76 {deprecated {No longer in use, changed to macro}} { +#declare 76 { # void Tcl_BackgroundError(Tcl_Interp *interp) #} # Removed in 9.0: -#declare 77 {deprecated {Use Tcl_UtfBackslash}} { +#declare 77 { # char Tcl_Backslash(const char *src, int *readPtr) #} declare 78 { @@ -366,7 +366,7 @@ declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } # Removed in 9.0: -#declare 95 {deprecated {}} { +#declare 95 { # void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, # int numArgs, Tcl_ValueType *argTypes, # Tcl_MathProc *proc, void *clientData) @@ -643,7 +643,7 @@ declare 173 { # const char *Tcl_GetStringResult(Tcl_Interp *interp) #} # Removed in 9.0, replaced by macro. -#declare 175 {deprecated {No longer in use, changed to macro}} { +#declare 175 { # const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, # int flags) #} @@ -859,7 +859,7 @@ declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } # Removed in 9.0, replaced by macro. -#declare 237 {deprecated {No longer in use, changed to macro}} { +#declare 237 { # const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, # const char *newValue, int flags) #} @@ -898,7 +898,7 @@ declare 243 { # int Tcl_TellOld(Tcl_Channel chan) #} # Removed in 9.0, replaced by macro. -#declare 247 {deprecated {No longer in use, changed to macro}} { +#declare 247 { # int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, # Tcl_VarTraceProc *proc, ClientData clientData) #} @@ -920,7 +920,7 @@ declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } # Removed in 9.0, replaced by macro. -#declare 253 {deprecated {No longer in use, changed to macro}} { +#declare 253 { # int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) #} declare 254 { @@ -928,7 +928,7 @@ declare 254 { int flags) } # Removed in 9.0, replaced by macro. -#declare 255 {deprecated {No longer in use, changed to macro}} { +#declare 255 { # void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, # Tcl_VarTraceProc *proc, ClientData clientData) #} @@ -941,7 +941,7 @@ declare 257 { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName) } # Removed in 9.0, replaced by macro. -#declare 258 {deprecated {No longer in use, changed to macro}} { +#declare 258 { # int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, # const char *varName, const char *localName, int flags) #} @@ -953,7 +953,7 @@ declare 260 { int Tcl_VarEval(Tcl_Interp *interp, ...) } # Removed in 9.0, replaced by macro. -#declare 261 {deprecated {No longer in use, changed to macro}} { +#declare 261 { # ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, # int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) #} @@ -991,7 +991,7 @@ declare 270 { const char **termPtr) } # Removed in 9.0, replaced by macro. -#declare 271 {deprecated {No longer in use, changed to macro}} { +#declare 271 { # const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, # const char *version, int exact) #} @@ -1001,13 +1001,13 @@ declare 272 { void *clientDataPtr) } # Removed in 9.0, replaced by macro. -#declare 273 {deprecated {No longer in use, changed to macro}} { +#declare 273 { # int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, # const char *version) #} # TIP #268: The internally used new Require function is in slot 573. # Removed in 9.0, replaced by macro. -#declare 274 {deprecated {No longer in use, changed to macro}} { +#declare 274 { # const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, # const char *version, int exact) #} @@ -1167,11 +1167,11 @@ declare 313 { size_t charsToRead, int appendFlag) } # Removed in 9.0, replaced by macro. -#declare 314 {deprecated {No longer in use, changed to macro}} { +#declare 314 { # void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) #} # Removed in 9.0, replaced by macro. -#declare 315 {deprecated {No longer in use, changed to macro}} { +#declare 315 { # void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) #} declare 316 { @@ -1256,11 +1256,11 @@ declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } # Removed in 9.0: -#declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { +#declare 341 { # const char *Tcl_GetDefaultEncodingDir(void) #} # Removed in 9.0: -#declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { +#declare 342 { # void Tcl_SetDefaultEncodingDir(const char *path) #} declare 343 { @@ -1290,13 +1290,15 @@ declare 350 { declare 351 { int Tcl_UniCharIsWordChar(int ch) } -declare 352 { - size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr) -} -declare 353 { - int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - size_t numChars) -} +# Removed in 9.0: +#declare 352 { +# size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr) +#} +# Removed in 9.0: +#declare 353 { +# int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, +# size_t numChars) +#} declare 354 { char *Tcl_Char16ToUtfDString(const unsigned short *uniStr, size_t uniLength, Tcl_DString *dsPtr) @@ -1310,7 +1312,7 @@ declare 356 { int flags) } # Removed in 9.0: -#declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { +#declare 357 { # Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, # int count) #} @@ -1399,16 +1401,17 @@ declare 381 { int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index) } # Removed in 9.0, replaced by macro. -#declare 382 {deprecated {No longer in use, changed to macro}} { +#declare 382 { # Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) #} declare 383 { Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last) } -declare 384 { - void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - size_t length) -} +# Removed in 9.0 +#declare 384 { +# void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, +# size_t length) +#} declare 385 { int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj) @@ -1531,14 +1534,16 @@ declare 417 { declare 418 { int Tcl_IsChannelExisting(const char *channelName) } -declare 419 { - int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - size_t numChars) -} -declare 420 { - int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, - const Tcl_UniChar *uniPattern, int nocase) -} +# Removed in 9.0: +#declare 419 { +# int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, +# size_t numChars) +#} +# Removed in 9.0: +#declare 420 { +# int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, +# const Tcl_UniChar *uniPattern, int nocase) +#} # Removed in 9.0, as it is actually a macro: #declare 421 { # Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) @@ -1597,13 +1602,13 @@ declare 434 { # TIP#15 (math function introspection) dkf # Removed in 9.0: -#declare 435 {deprecated {}} { +#declare 435 { # int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, # int *numArgsPtr, Tcl_ValueType **argTypesPtr, # Tcl_MathProc **procPtr, void **clientDataPtr) #} # Removed in 9.0: -#declare 436 {deprecated {}} { +#declare 436 { # Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) #} diff --git a/generic/tcl.h b/generic/tcl.h index 4ac51ed..4439fcd 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1936,16 +1936,15 @@ typedef struct Tcl_EncodingType { /* * The maximum number of bytes that are necessary to represent a single - * Unicode character in UTF-8. The valid values are 4 and 6 - * (or perhaps 1 if we want to support a non-unicode enabled core). If 4, - * then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6, - * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode - * is the default and recommended mode. UCS-4 is experimental and not - * recommended. It works for the core, but most extensions expect UCS-2. + * Unicode character in UTF-8. The valid values are 3 and 4 + * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3, + * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3, + * then Tcl_UniChar must be 2-bytes in size (UCS-2). Since Tcl 9.0, UCS-4 + * mode is the default and recommended mode. */ #ifndef TCL_UTF_MAX -#define TCL_UTF_MAX 6 +#define TCL_UTF_MAX 4 #endif /* @@ -1953,12 +1952,11 @@ typedef struct Tcl_EncodingType { * reflected in regcustom.h. */ -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 /* * int isn't 100% accurate as it should be a strict 4-byte value - * (perhaps wchar_t). 64-bit systems may have troubles. The size of this - * value must be reflected correctly in regcustom.h and - * in tclEncoding.c. + * (perhaps wchar_t). ILP64/SILP64 systems may have troubles. The + * size of this value must be reflected correctly in regcustom.h. */ typedef int Tcl_UniChar; #else diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 745ab1f..6ed7f3e 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -1349,7 +1349,7 @@ BinaryFormatCmd( badField: { Tcl_UniChar ch = 0; - char buf[TCL_UTF_MAX + 1] = ""; + char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; @@ -1720,7 +1720,7 @@ BinaryScanCmd( badField: { Tcl_UniChar ch = 0; - char buf[TCL_UTF_MAX + 1] = ""; + char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 1aa8229..832bfc2 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -3998,9 +3998,11 @@ Tcl_LsortObjCmd( size_t j, idx, groupSize, groupOffset; Tcl_WideInt wide; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; + size_t elmArrSize; SortElement *elementArray = NULL, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ +# define MAXCALLOC 1024000 # define NUM_LISTS 30 SortElement *subList[NUM_LISTS+1]; /* This array holds pointers to temporary @@ -4324,7 +4326,19 @@ Tcl_LsortObjCmd( * begins sorting it into the sublists as it appears. */ - elementArray = Tcl_Alloc(length * sizeof(SortElement)); + elmArrSize = length * sizeof(SortElement); + if (elmArrSize <= MAXCALLOC) { + elementArray = Tcl_Alloc(elmArrSize); + } else { + elementArray = malloc(elmArrSize); + } + if (!elementArray) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no enough memory to proccess sort of %d items", length)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + sortInfo.resultCode = TCL_ERROR; + goto done; + } for (i=0; i < length; i++) { idx = groupSize * i + groupOffset; @@ -4457,7 +4471,11 @@ Tcl_LsortObjCmd( TclStackFree(interp, sortInfo.indexv); } if (elementArray) { - Tcl_Free(elementArray); + if (elmArrSize <= MAXCALLOC) { + Tcl_Free(elementArray); + } else { + free((char *)elementArray); + } } return sortInfo.resultCode; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 3142d1a..847cdaa 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -606,7 +606,7 @@ Tcl_RegsubObjCmd( numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); - strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; + strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp; wsrc = TclGetUnicodeFromObj(objv[0], &slen); wstring = TclGetUnicodeFromObj(objv[1], &wlen); @@ -624,8 +624,8 @@ Tcl_RegsubObjCmd( resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); for (; wstring < wend; wstring++) { - Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); - Tcl_AppendUnicodeToObj(resultPtr, wstring, 1); + TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); + TclAppendUnicodeToObj(resultPtr, wstring, 1); numMatches++; } wlen = 0; @@ -641,14 +641,14 @@ Tcl_RegsubObjCmd( Tcl_IncrRefCount(resultPtr); } if (p != wstring) { - Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p); + TclAppendUnicodeToObj(resultPtr, p, wstring - p); p = wstring + slen; } else { p += slen; } wstring = p - 1; - Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); + TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); numMatches++; } } @@ -751,7 +751,7 @@ Tcl_RegsubObjCmd( * specified. */ - Tcl_AppendUnicodeToObj(resultPtr, wstring, offset); + TclAppendUnicodeToObj(resultPtr, wstring, offset); } } numMatches++; @@ -764,7 +764,7 @@ Tcl_RegsubObjCmd( Tcl_RegExpGetInfo(regExpr, &info); start = info.matches[0].start; end = info.matches[0].end; - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start); + TclAppendUnicodeToObj(resultPtr, wstring + offset, start); /* * In command-prefix mode, the substitutions are added as quoted @@ -785,7 +785,7 @@ Tcl_RegsubObjCmd( for (idx = 0 ; idx <= info.nsubs ; idx++) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; - if ((subStart >= 0) && (subEnd >= 0)) { + if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { args[idx + numParts] = Tcl_NewUnicodeObj( wstring + offset + subStart, subEnd - subStart); } else { @@ -839,7 +839,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); + TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } @@ -868,7 +868,7 @@ Tcl_RegsubObjCmd( idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; - Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, + TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar + 1); *wsrc = '\\'; wfirstChar = wsrc + 2; @@ -882,15 +882,15 @@ Tcl_RegsubObjCmd( } if (wfirstChar != wsrc) { - Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, + TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; - if ((subStart >= 0) && (subEnd >= 0)) { - Tcl_AppendUnicodeToObj(resultPtr, + if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { + TclAppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } @@ -902,7 +902,7 @@ Tcl_RegsubObjCmd( } if (wfirstChar != wsrc) { - Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); + TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (end == 0) { @@ -912,7 +912,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); + TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } else { @@ -924,7 +924,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); + TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } @@ -949,7 +949,7 @@ Tcl_RegsubObjCmd( resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); + TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (objc == 4) { if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, @@ -1222,7 +1222,7 @@ Tcl_SplitObjCmd( len = TclUtfToUniChar(stringPtr, &ch); fullchar = ch; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(stringPtr + len, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; @@ -1914,7 +1914,7 @@ StringIsCmd( int fullchar; length2 = TclUtfToUniChar(string1, &ch); fullchar = ch; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (length2 < 3)) { length2 += TclUtfToUniChar(string1 + length2, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; @@ -2095,7 +2095,7 @@ StringMapCmd( } end = ustring1 + length1; - strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp); + strCmpFn = (nocase ? TclUniCharNcasecmp : TclUniCharNcmp); /* * Force result to be Unicode @@ -2132,14 +2132,14 @@ StringMapCmd( (length2==1 || strCmpFn(ustring1, ustring2, length2) == 0)) { if (p != ustring1) { - Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); + TclAppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; - Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen); + TclAppendUnicodeToObj(resultPtr, mapString, mapLen); } } } @@ -2185,7 +2185,7 @@ StringMapCmd( * Put the skipped chars onto the result first. */ - Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); + TclAppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; @@ -2201,7 +2201,7 @@ StringMapCmd( * Append the map value to the unicode string. */ - Tcl_AppendUnicodeToObj(resultPtr, + TclAppendUnicodeToObj(resultPtr, mapStrings[index+1], mapLens[index+1]); break; } @@ -2218,7 +2218,7 @@ StringMapCmd( * Put the rest of the unmapped chars onto result. */ - Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); + TclAppendUnicodeToObj(resultPtr, p, ustring1 - p); } Tcl_SetObjResult(interp, resultPtr); done: diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 6047f81..eda991b 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -694,6 +694,7 @@ TclCompileStringIsCmd( OP( LNOT); return TCL_OK; } + break; case STR_IS_DOUBLE: { int satisfied, isEmpty; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index be71893..bc2db64 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -942,11 +942,8 @@ EXTERN int Tcl_UniCharIsSpace(int ch); EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); -/* 352 */ -EXTERN size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr); -/* 353 */ -EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); +/* Slot 352 is reserved */ +/* Slot 353 is reserved */ /* 354 */ EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr, size_t uniLength, Tcl_DString *dsPtr); @@ -1029,9 +1026,7 @@ EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); /* 383 */ EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last); -/* 384 */ -EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t length); +/* Slot 384 is reserved */ /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); @@ -1121,12 +1116,8 @@ EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ EXTERN int Tcl_IsChannelExisting(const char *channelName); -/* 419 */ -EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -/* 420 */ -EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, - const Tcl_UniChar *uniPattern, int nocase); +/* Slot 419 is reserved */ +/* Slot 420 is reserved */ /* Slot 421 is reserved */ /* Slot 422 is reserved */ /* 423 */ @@ -2154,8 +2145,8 @@ typedef struct TclStubs { int (*tcl_UniCharIsSpace) (int ch); /* 349 */ int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ - size_t (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ - int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */ + void (*reserved352)(void); + void (*reserved353)(void); char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 354 */ unsigned short * (*tcl_UtfToChar16DString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ @@ -2186,7 +2177,7 @@ typedef struct TclStubs { int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */ void (*reserved382)(void); Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */ - void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 384 */ + void (*reserved384)(void); int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */ void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ @@ -2221,8 +2212,8 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ - int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */ - int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ + void (*reserved419)(void); + void (*reserved420)(void); void (*reserved421)(void); void (*reserved422)(void); void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ @@ -3139,10 +3130,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ -#define Tcl_UniCharLen \ - (tclStubsPtr->tcl_UniCharLen) /* 352 */ -#define Tcl_UniCharNcmp \ - (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ +/* Slot 352 is reserved */ +/* Slot 353 is reserved */ #define Tcl_Char16ToUtfDString \ (tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */ #define Tcl_UtfToChar16DString \ @@ -3201,8 +3190,7 @@ extern const TclStubs *tclStubsPtr; /* Slot 382 is reserved */ #define Tcl_GetRange \ (tclStubsPtr->tcl_GetRange) /* 383 */ -#define Tcl_AppendUnicodeToObj \ - (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */ +/* Slot 384 is reserved */ #define Tcl_RegExpMatchObj \ (tclStubsPtr->tcl_RegExpMatchObj) /* 385 */ #define Tcl_SetNotifier \ @@ -3271,10 +3259,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */ #define Tcl_IsChannelExisting \ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ -#define Tcl_UniCharNcasecmp \ - (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ -#define Tcl_UniCharCaseMatch \ - (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ +/* Slot 419 is reserved */ +/* Slot 420 is reserved */ /* Slot 421 is reserved */ /* Slot 422 is reserved */ #define Tcl_InitCustomHashTable \ @@ -3874,7 +3860,7 @@ extern const TclStubs *tclStubsPtr; #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString # undef Tcl_UtfToUniCharDString diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 86cfd10..a774ed2 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -902,7 +902,7 @@ PrintSourceToObj( i += 2; continue; default: -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 if (ch > 0xffff) { Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch); i += 10; diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index ef926e5..bda075a 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2553,7 +2553,7 @@ UtfToUtf16Proc( */ if (clientData) { -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 if (*chPtr <= 0xFFFF) { *dst++ = (*chPtr & 0xFF); *dst++ = (*chPtr >> 8); @@ -2568,7 +2568,7 @@ UtfToUtf16Proc( *dst++ = (*chPtr >> 8); #endif } else { -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 if (*chPtr <= 0xFFFF) { *dst++ = (*chPtr >> 8); *dst++ = (*chPtr & 0xFF); @@ -2635,7 +2635,7 @@ UtfToUcs2Proc( { const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 int len; #endif Tcl_UniChar ch = 0; @@ -2665,7 +2665,7 @@ UtfToUcs2Proc( result = TCL_CONVERT_NOSPACE; break; } -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 src += (len = TclUtfToUniChar(src, &ch)); if ((ch >= 0xD800) && (len < 3)) { src += TclUtfToUniChar(src, &ch); @@ -2889,7 +2889,7 @@ TableFromUtfProc( } len = TclUtfToUniChar(src, &ch); -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 /* * This prevents a crash condition. More evaluation is required for * full support of int Tcl_UniChar. [Bug 1004065] @@ -3100,7 +3100,7 @@ Iso88591FromUtfProc( */ if (ch > 0xff -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 || ((ch >= 0xD800) && (len < 3)) #endif ) { @@ -3108,7 +3108,7 @@ Iso88591FromUtfProc( result = TCL_CONVERT_UNKNOWN; break; } -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) len = 4; #endif /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 7488f2d..be458f3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -259,12 +259,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -272,6 +276,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ + break; \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ @@ -280,12 +285,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -293,6 +302,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ + break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ @@ -2519,23 +2529,27 @@ TEBCresume( objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); NEXT_INST_F(5, 0, 1); + break; case INST_POP: TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); NEXT_INST_F(1, 0, 0); + break; case INST_DUP: objResultPtr = OBJ_AT_TOS; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_F(5, 0, 1); + break; case INST_REVERSE: { Tcl_Obj **a, **b; @@ -2566,6 +2580,7 @@ TEBCresume( TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); + break; case INST_CONCAT_STK: /* @@ -2577,6 +2592,7 @@ TEBCresume( objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); + break; case INST_EXPAND_START: /* @@ -2598,6 +2614,7 @@ TEBCresume( PUSH_TAUX_OBJ(objPtr); TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH)); NEXT_INST_F(1, 0, 0); + break; case INST_EXPAND_DROP: /* @@ -2724,6 +2741,7 @@ TEBCresume( TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); @@ -4097,6 +4115,7 @@ TEBCresume( TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); + break; case INST_JUMP4: opnd = TclGetInt4AtPtr(pc+1); @@ -4221,6 +4240,7 @@ TEBCresume( TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_INFO_LEVEL_ARGS: { int level; CallFrame *framePtr = iPtr->varFramePtr; @@ -5259,14 +5279,14 @@ TEBCresume( memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { - Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); + TclAppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; - Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3); + TclAppendUnicodeToObj(objResultPtr, ustring3, length3); } } if (p != ustring1) { @@ -5274,7 +5294,7 @@ TEBCresume( * Put the rest of the unmapped chars onto result. */ - Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); + TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p); } doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", @@ -5453,7 +5473,6 @@ TEBCresume( JUMP_PEEPHOLE_F(match, 2, 2); } - break; /* * End of string-related instructions. @@ -5883,6 +5902,7 @@ TEBCresume( TclSetIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); + break; case INST_DIV: if (w2 == 0) { @@ -6022,6 +6042,7 @@ TEBCresume( /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); + break; case TCL_NUMBER_INT: w1 = *((const Tcl_WideInt *) ptr1); if (w1 != WIDE_MIN) { @@ -6147,6 +6168,7 @@ TEBCresume( } TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_BREAK: /* @@ -6378,6 +6400,7 @@ TEBCresume( TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1), (int) CURR_DEPTH)); NEXT_INST_F(5, 0, 0); + break; case INST_END_CATCH: catchTop--; @@ -6387,6 +6410,7 @@ TEBCresume( result = TCL_OK; TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1))); NEXT_INST_F(1, 0, 0); + break; case INST_PUSH_RESULT: objResultPtr = Tcl_GetObjResult(interp); @@ -6400,11 +6424,13 @@ TEBCresume( Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; NEXT_INST_F(1, 0, -1); + break; case INST_PUSH_RETURN_CODE: TclNewIntObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); + break; case INST_PUSH_RETURN_OPTIONS: DECACHE_STACK_INFO(); @@ -6412,6 +6438,7 @@ TEBCresume( CACHE_STACK_INFO(); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_RETURN_CODE_BRANCH: { int code; @@ -6451,6 +6478,7 @@ TEBCresume( } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); + break; case INST_DICT_EXISTS: { int found; @@ -7740,7 +7768,7 @@ ExecuteExtendedBinaryMathOp( mp_init(&bigResult); mp_init(&bigRemainder); mp_div(&big1, &big2, &bigResult, &bigRemainder); - if ((bigRemainder.used != 0) && (bigRemainder.sign != big2.sign)) { + if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* * Convert to Tcl's integer division rules. */ @@ -7971,7 +7999,7 @@ ExecuteExtendedBinaryMathOp( Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); negativeExponent = mp_isneg(&big2); mp_mod_2d(&big2, 1, &big2); - oddExponent = big2.used != 0; + oddExponent = !mp_iszero(&big2); mp_clear(&big2); } @@ -8288,7 +8316,7 @@ ExecuteExtendedBinaryMathOp( mp_mul(&big1, &big2, &bigResult); break; case INST_DIV: - if (big2.used == 0) { + if (mp_iszero(&big2)) { mp_clear(&big1); mp_clear(&big2); mp_clear(&bigResult); @@ -8297,7 +8325,7 @@ ExecuteExtendedBinaryMathOp( mp_init(&bigRemainder); mp_div(&big1, &big2, &bigResult, &bigRemainder); /* TODO: internals intrusion */ - if ((bigRemainder.used != 0) + if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* * Convert to Tcl's integer division rules. @@ -8452,6 +8480,7 @@ TclCompareTwoNumbers( mp_clear(&big2); return compare; } + break; case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); @@ -8498,6 +8527,7 @@ TclCompareTwoNumbers( Tcl_InitBignumFromDouble(NULL, d1, &big1); goto bigCompare; } + break; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); @@ -8534,10 +8564,11 @@ TclCompareTwoNumbers( mp_clear(&big2); return compare; } + break; default: Tcl_Panic("unexpected number type"); - return TCL_ERROR; } + return TCL_ERROR; } #ifdef TCL_COMPILE_DEBUG diff --git a/generic/tclIO.c b/generic/tclIO.c index d3b9bbb..242d182 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4721,7 +4721,7 @@ Tcl_GetsObj( Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp, - TCL_UTF_MAX, &rawRead, NULL, NULL); + sizeof(tmp), &rawRead, NULL, NULL); bufPtr->nextRemoved += rawRead; gs.rawRead -= rawRead; gs.bytesWrote--; @@ -6286,7 +6286,7 @@ ReadChars( Tcl_ExternalToUtf(NULL, encoding, src, srcLen, (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE), - &statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1, + &statePtr->inputEncodingState, buffer, sizeof(buffer), &read, &decoded, &count); if (count == 2) { diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index b2f2dca..d8ba787 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -171,7 +171,7 @@ const Tcl_Filesystem tclNativeFilesystem = { TclpObjCopyDirectory, TclpObjLstat, /* Needs casts since we're using version_2. */ - (Tcl_FSLoadFileProc *) TclpDlopen, + (Tcl_FSLoadFileProc *)(void *) TclpDlopen, (Tcl_FSGetCwdProc *) TclpGetNativeCwd, TclpObjChdir }; @@ -3177,7 +3177,7 @@ Tcl_LoadFile( } if (fsPtr->loadFileProc != NULL) { - int retVal = ((Tcl_FSLoadFileProc2 *)(fsPtr->loadFileProc)) + int retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc)) (interp, pathPtr, handlePtr, &unloadProcPtr, flags); if (retVal == TCL_OK) { diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 8b1b3a6..5477f5f 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1065,6 +1065,11 @@ declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } +# TIP 542 +declare 259 { + void TclAppendUnicodeToObj(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, size_t length) +} ############################################################################## diff --git a/generic/tclInt.h b/generic/tclInt.h index ecfe847..f483e36 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4051,6 +4051,19 @@ MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); /* + * TIP #542 + */ + +MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); +MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, + const Tcl_UniChar *uniPattern, int nocase); + + +/* * Just for the purposes of command-type registration. */ @@ -4558,7 +4571,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, *---------------------------------------------------------------- */ -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 #define TclUtfToUniChar(str, chPtr) \ ((((unsigned char) *(str)) < 0x80) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ @@ -4632,8 +4645,6 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #ifdef WORDS_BIGENDIAN # define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) -#else /* !WORDS_BIGENDIAN */ -# define TclUniCharNcmp Tcl_UniCharNcmp #endif /* WORDS_BIGENDIAN */ /* diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 580c959..939134b 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -581,6 +581,9 @@ EXTERN void TclStaticPackage(Tcl_Interp *interp, /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); +/* 259 */ +EXTERN void TclAppendUnicodeToObj(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, size_t length); typedef struct TclIntStubs { int magic; @@ -845,6 +848,7 @@ typedef struct TclIntStubs { int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ + void (*tclAppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 259 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; @@ -1262,6 +1266,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ +#define TclAppendUnicodeToObj \ + (tclIntStubsPtr->tclAppendUnicodeToObj) /* 259 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 062e1a0..67388e8 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -882,7 +882,7 @@ Tcl_UnloadObjCmd( for (ipPrevPtr = ipPtr; ipPtr != NULL; ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { - if (ipPtr->pkgPtr == pkgPtr) { + if (ipPtr->pkgPtr == defaultPtr) { ipPrevPtr->nextPtr = ipPtr->nextPtr; break; } diff --git a/generic/tclParse.c b/generic/tclParse.c index b5fa16d..36ba1ed 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -937,7 +937,7 @@ TclParseBackslash( if (Tcl_UtfCharComplete(p, numBytes - 1)) { count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */ } else { - char utfBytes[TCL_UTF_MAX]; + char utfBytes[4]; memcpy(utfBytes, p, numBytes - 1); utfBytes[numBytes - 1] = '\0'; diff --git a/generic/tclScan.c b/generic/tclScan.c index f499711..20cb9d0 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -265,7 +265,7 @@ ValidateFormat( * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ - char buf[TCL_UTF_MAX + 1] = ""; + char buf[5] = ""; /* * Initialize an array that records the number of times a variable is @@ -877,7 +877,7 @@ Tcl_ScanObjCmd( offset = TclUtfToUniChar(string, &sch); i = (int)sch; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((sch >= 0xD800) && (offset < 3)) { offset += TclUtfToUniChar(string+offset, &sch); i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 699910f..e0c9f15 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -15,18 +15,11 @@ #include "tclInt.h" #include "tclTomMath.h" +#include <float.h> #include <math.h> -/* - * Older MSVC has no copysign function, but it's available at least since - * MSVC++ 12.0 (that is Visual Studio 2013). - */ - -#if (defined(_MSC_VER) && (_MSC_VER < 1800)) -inline static double -copysign(double a, double b) { - return _copysign(a, b); -} +#ifdef _WIN32 +#define copysign _copysign #endif /* @@ -1248,7 +1241,7 @@ TclParseNumber( case DECIMAL: significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1, &significandWide, &significandBig, significandOverflow); - if (!significandOverflow && (significandWide > MOST_BITS+signum)){ + if (!significandOverflow && (significandWide > MOST_BITS+signum)) { significandOverflow = 1; mp_init_u64(&significandBig, significandWide); } @@ -1345,7 +1338,7 @@ TclParseNumber( #ifdef IEEE_FLOATING_POINT case sNAN: case sNANFINISH: - objPtr->internalRep.doubleValue = MakeNaN(signum,significandWide); + objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide); objPtr->typePtr = &tclDoubleType; break; #endif @@ -4357,7 +4350,8 @@ TclInitDoubleConversion(void) maxpow10_wide = (int) floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.)); - pow10_wide = Tcl_Alloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); + pow10_wide = (Tcl_WideUInt *) + Tcl_Alloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); u = 1; for (i = 0; i < maxpow10_wide; ++i) { pow10_wide[i] = u; @@ -4685,7 +4679,7 @@ TclCeil( mp_int d; mp_init(&d); mp_div_2d(a, -shift, &b, &d); - exact = d.used == 0; + exact = mp_iszero(&d); mp_clear(&d); } else { mp_copy(a, &b); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 056fb37..d78112f 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -553,7 +553,7 @@ Tcl_GetUniChar( return -1; } ch = stringPtr->unicode[index]; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* See: bug [11ae2be95dac9417] */ if ((ch & 0xF800) == 0xD800) { if (ch & 0x400) { @@ -710,7 +710,7 @@ Tcl_GetRange( if (last < first) { return Tcl_NewObj(); } -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* See: bug [11ae2be95dac9417] */ if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { @@ -1165,7 +1165,7 @@ Tcl_AppendToObj( /* *---------------------------------------------------------------------- * - * Tcl_AppendUnicodeToObj -- + * TclAppendUnicodeToObj -- * * This function appends a Unicode string to an object in the most * efficient manner possible. Length must be >= 0. @@ -1180,7 +1180,7 @@ Tcl_AppendToObj( */ void -Tcl_AppendUnicodeToObj( +TclAppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ @@ -1189,7 +1189,7 @@ Tcl_AppendUnicodeToObj( String *stringPtr; if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); + Tcl_Panic("%s called with shared object", "TclAppendUnicodeToObj"); } if (length == 0) { @@ -2166,7 +2166,7 @@ Tcl_AppendFormatToObj( uw /= base; } #endif - } else if (useBig && big.used) { + } else if (useBig && !mp_iszero(&big)) { int leftover = (big.used * MP_DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); @@ -2205,7 +2205,7 @@ Tcl_AppendFormatToObj( while (numDigits--) { int digitOffset; - if (useBig && big.used) { + if (useBig && !mp_iszero(&big)) { if (index < big.used && (size_t) shift < CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) { bits |= ((Tcl_WideUInt) big.dp[index++]) << shift; @@ -2509,7 +2509,7 @@ AppendPrintfToObjVA( end = q; } - q = bytes + TCL_UTF_MAX; + q = bytes + 4; while ((bytes < end) && (bytes < q) && ((*bytes & 0xC0) == 0x80)) { bytes++; @@ -2832,7 +2832,7 @@ TclStringRepeat( Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } - Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), + TclAppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), (count - done) * length); } else { /* @@ -3299,7 +3299,7 @@ TclStringCmp( if (nocase) { s1 = (char *) TclGetUnicodeFromObj(value1Ptr, &s1len); s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len); - memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp; + memCmpFn = (memCmpFn_t)TclUniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); @@ -3324,7 +3324,7 @@ TclStringCmp( s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); } else { - memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp; + memCmpFn = (memCmpFn_t) TclUniCharNcmp; } } } @@ -3889,7 +3889,7 @@ TclStringReplace( Tcl_AppendObjToObj(result, insertPtr); } if (first + count < (size_t)numChars) { - Tcl_AppendUnicodeToObj(result, ustring + first + count, + TclAppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7250bd8..59dba15 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -40,6 +40,9 @@ #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_GetUnicode +#undef Tcl_GetUnicodeFromObj +#undef Tcl_NewUnicodeObj +#undef Tcl_SetUnicodeObj #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry @@ -64,6 +67,16 @@ #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar +#if TCL_UTF_MAX <= 3 +static void uniCodePanic() { + Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX); +} +# define Tcl_GetUnicode (int *(*)(Tcl_Obj *)) uniCodePanic +# define Tcl_GetUnicodeFromObj (int *(*)(Tcl_Obj *, Tcl_UniChar *)) uniCodePanic +# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, Tcl_UniChar)) uniCodePanic +# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int)) uniCodePanic +#endif + #define TclBN_mp_add mp_add #define TclBN_mp_add_d mp_add_d #define TclBN_mp_and mp_and @@ -218,22 +231,14 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj -static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp static int utfNcmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcmp(s1, s2, (unsigned long)n); } -#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp +#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcmp static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); } -#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp -static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp +#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp #endif /* TCL_WIDE_INT_IS_LONG */ @@ -521,6 +526,7 @@ static const TclIntStubs tclIntStubs = { TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ + TclAppendUnicodeToObj, /* 259 */ }; static const TclIntPlatStubs tclIntPlatStubs = { @@ -1107,8 +1113,8 @@ const TclStubs tclStubs = { Tcl_UniCharIsSpace, /* 349 */ Tcl_UniCharIsUpper, /* 350 */ Tcl_UniCharIsWordChar, /* 351 */ - Tcl_UniCharLen, /* 352 */ - Tcl_UniCharNcmp, /* 353 */ + 0, /* 352 */ + 0, /* 353 */ Tcl_Char16ToUtfDString, /* 354 */ Tcl_UtfToChar16DString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ @@ -1139,7 +1145,7 @@ const TclStubs tclStubs = { Tcl_GetUniChar, /* 381 */ 0, /* 382 */ Tcl_GetRange, /* 383 */ - Tcl_AppendUnicodeToObj, /* 384 */ + 0, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ Tcl_SetNotifier, /* 386 */ Tcl_GetAllocMutex, /* 387 */ @@ -1174,8 +1180,8 @@ const TclStubs tclStubs = { Tcl_SpliceChannel, /* 416 */ Tcl_ClearChannelHandlers, /* 417 */ Tcl_IsChannelExisting, /* 418 */ - Tcl_UniCharNcasecmp, /* 419 */ - Tcl_UniCharCaseMatch, /* 420 */ + 0, /* 419 */ + 0, /* 420 */ 0, /* 421 */ 0, /* 422 */ Tcl_InitCustomHashTable, /* 423 */ diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 34965d1..6fc1176 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1407,7 +1407,7 @@ TeststringobjCmd( return TCL_ERROR; } - Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i); + TclAppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 6e3282b..0173d78 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -788,7 +788,7 @@ Tcl_UtfFindFirst( while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &find); fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; @@ -837,7 +837,7 @@ Tcl_UtfFindLast( while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &find); fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; @@ -880,7 +880,7 @@ Tcl_UtfNext( Tcl_UniChar ch = 0; size_t len = TclUtfToUniChar(src, &ch); -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); } @@ -962,20 +962,20 @@ Tcl_UniCharAtIndex( { Tcl_UniChar ch = 0; int fullchar = 0; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 size_t len = 0; #endif src += TclUtfToUniChar(src, &ch); while (index--) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 src += (len = TclUtfToUniChar(src, &ch)); #else src += TclUtfToUniChar(src, &ch); #endif } fullchar = ch; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { /* If last Tcl_UniChar was a high surrogate, combine with low surrogate */ (void)TclUtfToUniChar(src, &ch); @@ -991,7 +991,7 @@ Tcl_UniCharAtIndex( * Tcl_UtfAtIndex -- * * Returns a pointer to the specified character (not byte) position in - * the UTF-8 string. If TCL_UTF_MAX <= 4, characters > U+FFFF count as + * the UTF-8 string. If TCL_UTF_MAX <= 3, characters > U+FFFF count as * 2 positions, but then the pointer should never be placed between * the two positions. * @@ -1022,7 +1022,7 @@ Tcl_UtfAtIndex( src += TclUtfToUniChar(src, &ch); #endif } -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { /* Index points at character following high Surrogate */ src += TclUtfToUniChar(src, &ch); @@ -1119,7 +1119,7 @@ Tcl_UtfToUpper( while (*src) { len = TclUtfToUniChar(src, &ch); upChar = ch; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ @@ -1181,7 +1181,7 @@ Tcl_UtfToLower( while (*src) { len = TclUtfToUniChar(src, &ch); lowChar = ch; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ @@ -1246,7 +1246,7 @@ Tcl_UtfToTitle( if (*src) { len = TclUtfToUniChar(src, &ch); titleChar = ch; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ @@ -1266,7 +1266,7 @@ Tcl_UtfToTitle( while (*src) { len = TclUtfToUniChar(src, &ch); lowChar = ch; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ @@ -1378,7 +1378,7 @@ Tcl_UtfNcmp( cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { @@ -1429,7 +1429,7 @@ Tcl_UtfNcasecmp( cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { @@ -1478,7 +1478,7 @@ TclUtfCmp( cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { @@ -1524,7 +1524,7 @@ TclUtfCasecmp( cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { @@ -1648,7 +1648,7 @@ Tcl_UniCharToTitle( /* *---------------------------------------------------------------------- * - * Tcl_UniCharLen -- + * TclUniCharLen -- * * Find the length of a UniChar string. The str input must be null * terminated. @@ -1663,7 +1663,7 @@ Tcl_UniCharToTitle( */ size_t -Tcl_UniCharLen( +TclUniCharLen( const Tcl_UniChar *uniStr) /* Unicode string to find length of. */ { size_t len = 0; @@ -1678,7 +1678,7 @@ Tcl_UniCharLen( /* *---------------------------------------------------------------------- * - * Tcl_UniCharNcmp -- + * TclUniCharNcmp -- * * Compare at most numChars unichars of string ucs to string uct. * Both ucs and uct are assumed to be at least numChars unichars long. @@ -1693,7 +1693,7 @@ Tcl_UniCharLen( */ int -Tcl_UniCharNcmp( +TclUniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ size_t numChars) /* Number of unichars to compare. */ @@ -1722,7 +1722,7 @@ Tcl_UniCharNcmp( /* *---------------------------------------------------------------------- * - * Tcl_UniCharNcasecmp -- + * TclUniCharNcasecmp -- * * Compare at most numChars unichars of string ucs to string uct case * insensitive. Both ucs and uct are assumed to be at least numChars @@ -1738,7 +1738,7 @@ Tcl_UniCharNcmp( */ int -Tcl_UniCharNcasecmp( +TclUniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ size_t numChars) /* Number of unichars to compare. */ @@ -2068,7 +2068,7 @@ Tcl_UniCharIsWordChar( /* *---------------------------------------------------------------------- * - * Tcl_UniCharCaseMatch -- + * TclUniCharCaseMatch -- * * See if a particular Unicode string matches a particular pattern. * Allows case insensitivity. This is the Unicode equivalent of the char* @@ -2089,7 +2089,7 @@ Tcl_UniCharIsWordChar( */ int -Tcl_UniCharCaseMatch( +TclUniCharCaseMatch( const Tcl_UniChar *uniStr, /* Unicode String. */ const Tcl_UniChar *uniPattern, /* Pattern, which may contain special @@ -2156,7 +2156,7 @@ Tcl_UniCharCaseMatch( } } } - if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) { + if (TclUniCharCaseMatch(uniStr, uniPattern, nocase)) { return 1; } if (*uniStr == 0) { @@ -2262,7 +2262,7 @@ Tcl_UniCharCaseMatch( * * See if a particular Unicode string matches a particular pattern. * Allows case insensitivity. This is the Unicode equivalent of the char* - * Tcl_StringCaseMatch. This variant of Tcl_UniCharCaseMatch uses counted + * Tcl_StringCaseMatch. This variant of TclUniCharCaseMatch uses counted * Strings, so embedded NULLs are allowed. * * Results: diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 0f14290..98f6ba8 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -430,7 +430,7 @@ static const Tcl_Filesystem zipfsFilesystem = { NULL, /* renameFileProc */ NULL, /* copyDirectoryProc */ NULL, /* lstatProc */ - (Tcl_FSLoadFileProc *) ZipFSLoadFile, + (Tcl_FSLoadFileProc *)(void *)ZipFSLoadFile, NULL, /* getCwdProc */ NULL, /* chdirProc */ }; @@ -4682,7 +4682,7 @@ ZipFSLoadFile( Tcl_DecrRefCount(objs[1]); } - loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + loadFileProc = (Tcl_FSLoadFileProc2 *)(void *)tclNativeFilesystem.loadFileProc; if (loadFileProc) { ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } else { diff --git a/libtommath/tommath_private.h b/libtommath/tommath_private.h index 072d603..5123f53 100644 --- a/libtommath/tommath_private.h +++ b/libtommath/tommath_private.h @@ -276,10 +276,6 @@ MP_DEPRECATED(s_mp_reverse) void bn_reverse(unsigned char *s, int len); MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used); \ } -#ifdef _MSC_VER -/* Prevent false positive: unary minus operator applied to unsigned type, result still unsigned */ -#pragma warning(disable: 4146) -#endif #define MP_SET_SIGNED(name, uname, type, utype) \ void name(mp_int * a, type b) \ { \ diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 215796f..be4d2d6 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -19,6 +19,7 @@ catch [list package require -exact Tcltest [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] +testConstraint prlimit [expr {[testConstraint macOrUnix] && ![catch { exec prlimit -n }]}] test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort @@ -519,6 +520,39 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body { test cmdIL-5.6 {lsort with multiple list-style index options} { lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}} } {{a b} {b e} {c d}} +test cmdIL-5.7 {lsort memory exhaustion} -constraints {prlimit} -body { + # test it in child process (with limited address space): + set pipe {} + if {[catch { + set pipe [open |[list [interpreter]] r+] + exec prlimit -p [pid $pipe] --as=80000000 + } msg]} { + catch {close $pipe} + tcltest::Skip "prlimit: error - [regsub {^\s*([^\n]*).*$} $msg {\1}]" + } + # if no error (enough memory), or error by list creation - add it as skipped test: + if {![catch { + chan configure $pipe -buffering line + puts $pipe { + # create list and get length (avoid too long output in interactive shells): + llength [set l [lrepeat 4000000 ""]] + # test OOM: + puts [llength [lsort $l]] + exit + } + set result [read $pipe] + close $pipe + set pipe {} + set result + } result] || [regexp {^(?:list creation failed|unable to (?:re)?alloc)} $result]} { + tcltest::Skip "prlimit: wrong AS-limit, result: $result" + } + set result + # expecting error no memory by sort +} -cleanup { + if {$pipe ne ""} { catch { close $pipe } } + unset -nocomplain pipe line result +} -result {no enough memory to proccess sort of 4000000 items} # Compiled version test cmdIL-6.1 {lassign command syntax} -returnCodes error -body { diff --git a/tests/oo.test b/tests/oo.test index 235a90d..3b56f30 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -111,8 +111,8 @@ test oo-0.8 {leak in variable management} -setup { } -result 0 test oo-0.9 {various types of presence of the TclOO package} { list [lsearch -nocase -all -inline [package names] tcloo] \ - [package present TclOO] [package versions TclOO] -} [list TclOO $::oo::patchlevel $::oo::patchlevel] + [package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}] +} [list TclOO $::oo::patchlevel 1] test oo-1.1 {basic test of OO functionality: no classes} { set result {} diff --git a/tests/stringObj.test b/tests/stringObj.test index bda7285..a1c0600 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -23,6 +23,8 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] +testConstraint tip497 [expr {[string length \U010000] == 1}] +testConstraint nodep [info exists tcl_precision] test stringObj-1.1 {string type registration} testobj { set t [testobj types] @@ -464,19 +466,19 @@ test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 3 } foo -test stringObj-15.5 {Tcl_Append*ToObj: self appends} testobj { +test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip497} { teststringobj set 1 foo teststringobj appendself2 1 0 } foofoo -test stringObj-15.6 {Tcl_Append*ToObj: self appends} testobj { +test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip497} { teststringobj set 1 foo teststringobj appendself2 1 1 } foooo -test stringObj-15.7 {Tcl_Append*ToObj: self appends} testobj { +test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip497} { teststringobj set 1 foo teststringobj appendself2 1 2 } fooo -test stringObj-15.8 {Tcl_Append*ToObj: self appends} testobj { +test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip497} { teststringobj set 1 foo teststringobj appendself2 1 3 } foo diff --git a/unix/configure b/unix/configure index f4e756f..b01a4bc 100755 --- a/unix/configure +++ b/unix/configure @@ -4681,12 +4681,13 @@ fi if test $libtommath_ok = yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing mp_log_u32" >&5 -$as_echo_n "checking for library containing mp_log_u32... " >&6; } -if ${ac_cv_search_mp_log_u32+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mp_log_u32 in -ltommath" >&5 +$as_echo_n "checking for mp_log_u32 in -ltommath... " >&6; } +if ${ac_cv_lib_tommath_mp_log_u32+:} false; then : $as_echo_n "(cached) " >&6 else - ac_func_search_save_LIBS=$LIBS + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltommath $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -4705,40 +4706,22 @@ return mp_log_u32 (); return 0; } _ACEOF -for ac_lib in '' tommath; do - if test -z "$ac_lib"; then - ac_res="none required" - else - ac_res=-l$ac_lib - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - fi - if ac_fn_c_try_link "$LINENO"; then : - ac_cv_search_mp_log_u32=$ac_res -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext - if ${ac_cv_search_mp_log_u32+:} false; then : - break -fi -done -if ${ac_cv_search_mp_log_u32+:} false; then : - +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tommath_mp_log_u32=yes else - ac_cv_search_mp_log_u32=no + ac_cv_lib_tommath_mp_log_u32=no fi -rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_mp_log_u32" >&5 -$as_echo "$ac_cv_search_mp_log_u32" >&6; } -ac_res=$ac_cv_search_mp_log_u32 -if test "$ac_res" != no; then : - test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" - +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tommath_mp_log_u32" >&5 +$as_echo "$ac_cv_lib_tommath_mp_log_u32" >&6; } +if test "x$ac_cv_lib_tommath_mp_log_u32" = xyes; then : + MATH_LIBS="$MATH_LIBS -ltommath" else - libtommath_ok=no - + libtommath_ok=no fi fi @@ -6600,7 +6583,7 @@ fi if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then : LIB_SUFFIX=${SHARED_LIB_SUFFIX} - MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' + MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' if test "${SHLIB_SUFFIX}" = ".dll"; then : INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' diff --git a/unix/configure.ac b/unix/configure.ac index 434af9d..e9176ad 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -180,9 +180,8 @@ if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then AC_CHECK_TYPE([mp_int],[],[libtommath_ok=no],[#include <tommath.h>])],[ libtommath_ok=no]) AS_IF([test $libtommath_ok = yes], [ - AC_SEARCH_LIBS([mp_log_u32],[tommath],[],[ - libtommath_ok=no - ])]) + AC_CHECK_LIB([tommath],[mp_log_u32],[MATH_LIBS="$MATH_LIBS -ltommath"],[ + libtommath_ok=no])]) fi AS_IF([test $libtommath_ok = yes], [ AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath]) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 9fa0675..1c4653e 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1821,7 +1821,7 @@ dnl # preprocessing tests use only CPPFLAGS. AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [ LIB_SUFFIX=${SHARED_LIB_SUFFIX} - MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' + MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in index ca932d2..a343707 100644 --- a/unix/tcl.pc.in +++ b/unix/tcl.pc.in @@ -11,7 +11,7 @@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. URL: http://www.tcl.tk/ Version: @TCL_VERSION@@TCL_PATCH_LEVEL@ -Requires.private: zlib >= 1.2.3 +Requires.private: zlib >= 1.2.3, libtommath >= 1.2.0 Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@ Libs.private: @TCL_LIBS@ Cflags: -I${includedir} diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index afb8b1c..7b1a4bb 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -258,9 +258,9 @@ TclpThreadCreate( } if (pthread_create(&theThread, &attr, - (void * (*)(void *)) proc, (void *) clientData) && + (void * (*)(void *))(void *)proc, (void *) clientData) && pthread_create(&theThread, NULL, - (void * (*)(void *)) proc, (void *) clientData)) { + (void * (*)(void *))(void *)proc, (void *) clientData)) { result = TCL_ERROR; } else { *idPtr = (Tcl_ThreadId) theThread; diff --git a/win/rules.vc b/win/rules.vc index 8fc8864..d1d8581 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -684,7 +684,7 @@ LINKERFLAGS = $(LINKERFLAGS) -ltcg # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking
# CONFIG_CHECK - 1 -> check current build configuration against Tcl
# configuration (ignored for Tcl itself)
-# TCL_UTF_MAX=6 - forces a build using 32-bit Tcl_UniChar in stead of 16-bit.
+# TCL_UTF_MAX=4 - forces a build allowing 4-byte UTF-8 sequences internally.
# Further, LINKERFLAGS are modified based on above.
# Default values for all the above
@@ -754,8 +754,8 @@ USE_THREAD_ALLOC= 1 !endif
!if [nmakehlp -f $(OPTS) "utfmax"]
-!message *** Force 32-bit Tcl_UniChar
-TCL_UTF_MAX = 6
+!message *** Force allowing 4-byte UTF-8 sequences internally
+TCL_UTF_MAX = 4
!endif
# Yes, it's weird that the "symbols" option controls DEBUG and
@@ -1353,8 +1353,8 @@ OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1
!endif
-!if "$(TCL_UTF_MAX)" == "6"
-OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=6
+!if "$(TCL_UTF_MAX)" == "4"
+OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=4
!endif
# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 1f03b1d..d2fa32c 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -454,10 +454,16 @@ const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { + UINT acp = GetACP(); + Tcl_DStringInit(bufPtr); - Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); - wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP()); - Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); + if (acp == CP_UTF8) { + Tcl_DStringAppend(bufPtr, "utf-8", 5); + } else { + Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); + wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP()); + Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); + } return Tcl_DStringValue(bufPtr); } |