Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | dgp-refactor |
Files: | files | file ages | folders |
SHA3-256: |
0f0012b0b7842c0fb6d7e9a57f327e72 |
User & Date: | dgp 2020-01-22 15:43:38 |
2020-01-24
| ||
12:53 | merge trunk check-in: b8d5fec60c user: dgp tags: dgp-refactor | |
2020-01-22
| ||
15:43 | merge trunk check-in: 0f0012b0b7 user: dgp tags: dgp-refactor | |
2020-01-21
| ||
22:14 | Implement TIp 543. check-in: 83d7bff763 user: dgp tags: trunk | |
2020-01-13
| ||
14:34 | merge trunk check-in: b2e462b310 user: dgp tags: dgp-refactor | |
Changes to .travis.yml.
1 2 3 4 5 6 7 8 9 10 11 12 | sudo: false language: c matrix: include: # Testing on Linux with various compilers - name: "Linux/GCC/Shared" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix | | | < < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | sudo: false language: c matrix: include: # Testing on Linux with various compilers - name: "Linux/GCC/Shared" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - name: "Linux/GCC/Shared: UTF_MAX=4" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4 - name: "Linux/GCC/Shared: NO_DEPRECATED" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" |
︙ | ︙ | |||
217 218 219 220 221 222 223 | before_install: &vcpreinst - PATH="$PATH:$VCDIR" - cd ${BUILD_DIR} install: [] script: - cmd.exe /C 'vcvarsall.bat x64 && nmake -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x64 && nmake -f makefile.vc test' | | | 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 | before_install: &vcpreinst - PATH="$PATH:$VCDIR" - cd ${BUILD_DIR} install: [] script: - cmd.exe /C 'vcvarsall.bat x64 && nmake -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x64 && nmake -f makefile.vc test' - name: "Windows/MSVC/Shared: UTF_MAX=4" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=utfmax -f makefile.vc all tcltest' |
︙ | ︙ | |||
263 264 265 266 267 268 269 | compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe /C 'vcvarsall.bat x86 && nmake -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x86 && nmake -f makefile.vc test' | | | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 | compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe /C 'vcvarsall.bat x86 && nmake -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x86 && nmake -f makefile.vc test' - name: "Windows/MSVC-x86/Shared: UTF_MAX=4" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=utfmax -f makefile.vc all tcltest' |
︙ | ︙ | |||
309 310 311 312 313 314 315 | compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit" before_install: &makepreinst - choco install -y make zip - cd ${BUILD_DIR} | | | < < < < < < < | 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit" before_install: &makepreinst - choco install -y make zip - cd ${BUILD_DIR} - name: "Windows/GCC/Shared: UTF_MAX=4" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=4" before_install: *makepreinst - name: "Windows/GCC/Shared: NO_DEPRECATED" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" |
︙ | ︙ | |||
351 352 353 354 355 356 357 | # Test on Windows with GCC native (32-bit) - name: "Windows/GCC-x86/Shared" os: windows compiler: gcc env: - BUILD_DIR=win before_install: *makepreinst | | | < < < < < < < | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 | # Test on Windows with GCC native (32-bit) - name: "Windows/GCC-x86/Shared" os: windows compiler: gcc env: - BUILD_DIR=win before_install: *makepreinst - name: "Windows/GCC-x86/Shared: UTF_MAX=4" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="CFLAGS=-DTCL_UTF_MAX=4" before_install: *makepreinst - name: "Windows/GCC-x86/Shared: NO_DEPRECATED" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" |
︙ | ︙ |
Changes to doc/TraceVar.3.
1 2 3 4 5 6 7 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_TraceVar 3 9.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable .SH SYNOPSIS .nf \fB#include <tcl.h>\fR |
︙ | ︙ | |||
91 92 93 94 95 96 97 | \fBTCL_TRACE_WRITES\fR Invoke \fIproc\fR whenever an attempt is made to modify the variable. .TP \fBTCL_TRACE_UNSETS\fR Invoke \fIproc\fR whenever the variable is unset. A variable may be unset either explicitly by an \fBunset\fR command, or implicitly when a procedure returns (its local variables are | | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | \fBTCL_TRACE_WRITES\fR Invoke \fIproc\fR whenever an attempt is made to modify the variable. .TP \fBTCL_TRACE_UNSETS\fR Invoke \fIproc\fR whenever the variable is unset. A variable may be unset either explicitly by an \fBunset\fR command, or implicitly when a procedure returns (its local variables are automatically unset) or when the interpreter or namespace is deleted (all variables are automatically unset). .TP \fBTCL_TRACE_ARRAY\fR Invoke \fIproc\fR whenever the array command is invoked. This gives the trace procedure a chance to update the array before array names or array get is called. Note that this is called before an array set, but that will trigger write traces. |
︙ | ︙ | |||
156 157 158 159 160 161 162 | procedure call: the trace procedure will need to pass this flag back to variable-related procedures like \fBTcl_GetVar\fR if it attempts to access the variable. The bit \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about to be destroyed; this information may be useful to \fIproc\fR so that it can clean up its own internal data structures (see the section \fBTCL_TRACE_DESTROYED\fR below for more details). | < < < < | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | procedure call: the trace procedure will need to pass this flag back to variable-related procedures like \fBTcl_GetVar\fR if it attempts to access the variable. The bit \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about to be destroyed; this information may be useful to \fIproc\fR so that it can clean up its own internal data structures (see the section \fBTCL_TRACE_DESTROYED\fR below for more details). The trace procedure's return value should normally be NULL; see \fBERROR RETURNS\fR below for information on other possibilities. .PP \fBTcl_UntraceVar\fR may be used to remove a trace. If the variable specified by \fIinterp\fR, \fIvarName\fR, and \fIflags\fR has a trace set with \fIflags\fR, \fIproc\fR, and \fIclientData\fR, then the corresponding trace is removed. |
︙ | ︙ | |||
325 326 327 328 329 330 331 332 333 334 335 336 337 338 | value). .PP The return value from \fIproc\fR is only used during read and write tracing. During unset traces, the return value is ignored and all relevant trace procedures will always be invoked. .SH "RESTRICTIONS" .PP A trace procedure can be called at any time, even when there are partially formed results stored in the interpreter. If the trace procedure does anything that could damage this result (such as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR and related routines to save and restore the original state of the interpreter before it returns. | > > > > > > > > > > | 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 | value). .PP The return value from \fIproc\fR is only used during read and write tracing. During unset traces, the return value is ignored and all relevant trace procedures will always be invoked. .SH "RESTRICTIONS" .PP Because operations on variables may take place as part of the deletion of the interp that contains them, \fIproc\fR must be careful about checking what the \fIinterp\fR parameter can be used to do. The routine \fBTcl_InterpDeleted\fR is an important tool for this. When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able to invoke any scripts in \fIinterp\fR. You may encounter old code using a deprecated flag value \fBTCL_INTERP_DESTROYED\fR to signal this condition, but Tcl 9 no longer supports this. Any supported code must be converted to stop using it. .PP A trace procedure can be called at any time, even when there are partially formed results stored in the interpreter. If the trace procedure does anything that could damage this result (such as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR and related routines to save and restore the original state of the interpreter before it returns. |
︙ | ︙ | |||
350 351 352 353 354 355 356 | In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit is set in \fIflags\fR if the trace is being removed as part of the deletion. Traces on a variable are always removed whenever the variable is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for a whole-array trace invoked when only a single element of an array is unset. | < < < < < < < < < < < < < < < < | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 | In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit is set in \fIflags\fR if the trace is being removed as part of the deletion. Traces on a variable are always removed whenever the variable is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for a whole-array trace invoked when only a single element of an array is unset. .SH BUGS .PP Array traces are not yet integrated with the Tcl \fBinfo exists\fR command, nor is there Tcl-level access to array traces. .SH "SEE ALSO" trace(n) .SH KEYWORDS clientData, trace, variable |
Changes to doc/Utf.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1997 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Utf 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | '\" '\" Copyright (c) 1997 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Utf 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME 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 .sp typedef ... \fBTcl_UniChar\fR; .sp int |
︙ | ︙ | |||
116 117 118 119 120 121 122 123 124 125 126 127 128 129 | A null-terminated Unicode string. .AP "const Tcl_UniChar" *uniPattern in A null-terminated Unicode string. .AP "const unsigned short" *uStr in A null-terminated UTF-16 string. .AP "const wchar_t" *wStr in A null-terminated wchar_t 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. .AP size_t uniLength in The length of the Unicode string in characters. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. | > > > > > > | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | A null-terminated Unicode string. .AP "const Tcl_UniChar" *uniPattern in A null-terminated Unicode string. .AP "const unsigned short" *uStr in 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. .AP size_t uniLength in The length of the Unicode string in characters. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. |
︙ | ︙ | |||
142 143 144 145 146 147 148 | case-insensitive (1). .BE .SH DESCRIPTION .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 | | | | | 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | case-insensitive (1). .BE .SH DESCRIPTION .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 \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 \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 in \fIbuf\fR. If ch is a high surrogate (range U+D800 - U+DBFF), then the return value will be 1 and a single byte in the range 0xF0 - 0xF4 will be stored. If you still want to produce UTF-8 output for it (even though knowing it's an illegal code-point on its own), just call |
︙ | ︙ |
Changes to generic/regcustom.h.
︙ | ︙ | |||
80 81 82 83 84 85 86 | typedef Tcl_UniChar chr; /* The type itself. */ typedef int pchr; /* What it promotes to. */ typedef unsigned uchr; /* Unsigned type that will hold a chr. */ 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 */ | | | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | typedef Tcl_UniChar chr; /* The type itself. */ typedef int pchr; /* What it promotes to. */ typedef unsigned uchr; /* Unsigned type that will hold a chr. */ 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 > 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 */ #else #define CHRBITS 16 /* Bits in a chr; must not use sizeof */ #define CHR_MIN 0x0000 /* Smallest and largest chr; the value */ #define CHR_MAX 0xffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */ |
︙ | ︙ |
Changes to generic/tcl.decls.
︙ | ︙ | |||
151 152 153 154 155 156 157 | int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr) } declare 35 { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } # Removed in 9.0, replaced by macro. | | | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr) } declare 35 { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } # Removed in 9.0, replaced by macro. #declare 36 { # int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, # const char *const *tablePtr, const char *msg, int flags, int *indexPtr) #} declare 37 { int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr) } declare 38 { |
︙ | ︙ | |||
256 257 258 259 260 261 262 | declare 64 { void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length) } declare 65 { void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t length) } # Removed in 9.0, replaced by macro. | | | | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | declare 64 { void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length) } declare 65 { void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t length) } # Removed in 9.0, replaced by macro. #declare 66 { # void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) #} # Removed in 9.0, replaced by macro. #declare 67 { # void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, # int length) #} declare 68 { void Tcl_AllowExceptions(Tcl_Interp *interp) } declare 69 { |
︙ | ︙ | |||
290 291 292 293 294 295 296 | declare 74 { void Tcl_AsyncMark(Tcl_AsyncHandler async) } declare 75 { int Tcl_AsyncReady(void) } # Removed in 9.0 | | | | 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 | declare 74 { void Tcl_AsyncMark(Tcl_AsyncHandler async) } declare 75 { int Tcl_AsyncReady(void) } # Removed in 9.0 #declare 76 { # void Tcl_BackgroundError(Tcl_Interp *interp) #} # Removed in 9.0: #declare 77 { # char Tcl_Backslash(const char *src, int *readPtr) #} declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) } declare 79 { |
︙ | ︙ | |||
362 363 364 365 366 367 368 | declare 93 { void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } # Removed in 9.0: | | | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 | declare 93 { void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } # Removed in 9.0: #declare 95 { # void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, # int numArgs, Tcl_ValueType *argTypes, # Tcl_MathProc *proc, void *clientData) #} declare 96 { Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, |
︙ | ︙ | |||
639 640 641 642 643 644 645 | Tcl_Channel Tcl_GetStdChannel(int type) } # Removed in 9.0, replaced by macro. #declare 174 { # const char *Tcl_GetStringResult(Tcl_Interp *interp) #} # Removed in 9.0, replaced by macro. | | | 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 | Tcl_Channel Tcl_GetStdChannel(int type) } # Removed in 9.0, replaced by macro. #declare 174 { # const char *Tcl_GetStringResult(Tcl_Interp *interp) #} # Removed in 9.0, replaced by macro. #declare 175 { # const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, # int flags) #} declare 176 { const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } |
︙ | ︙ | |||
855 856 857 858 859 860 861 | declare 235 { void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr) } declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } # Removed in 9.0, replaced by macro. | | | 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 | declare 235 { void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr) } declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } # Removed in 9.0, replaced by macro. #declare 237 { # const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, # const char *newValue, int flags) #} declare 238 { const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) } |
︙ | ︙ | |||
894 895 896 897 898 899 900 | # int Tcl_StringMatch(const char *str, const char *pattern) #} # Removed in 9.0: #declare 246 { # int Tcl_TellOld(Tcl_Channel chan) #} # Removed in 9.0, replaced by macro. | | | 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 | # int Tcl_StringMatch(const char *str, const char *pattern) #} # Removed in 9.0: #declare 246 { # int Tcl_TellOld(Tcl_Channel chan) #} # Removed in 9.0, replaced by macro. #declare 247 { # int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, # Tcl_VarTraceProc *proc, ClientData clientData) #} declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData) } |
︙ | ︙ | |||
916 917 918 919 920 921 922 | declare 251 { void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName) } declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } # Removed in 9.0, replaced by macro. | | | | | | 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 | declare 251 { void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName) } declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } # Removed in 9.0, replaced by macro. #declare 253 { # int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) #} declare 254 { int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } # Removed in 9.0, replaced by macro. #declare 255 { # void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, # Tcl_VarTraceProc *proc, ClientData clientData) #} declare 256 { void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData) } declare 257 { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName) } # Removed in 9.0, replaced by macro. #declare 258 { # int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, # const char *varName, const char *localName, int flags) #} declare 259 { int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags) } declare 260 { int Tcl_VarEval(Tcl_Interp *interp, ...) } # Removed in 9.0, replaced by macro. #declare 261 { # ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, # int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) #} declare 262 { void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData) |
︙ | ︙ | |||
987 988 989 990 991 992 993 | char *Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 { const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr) } # Removed in 9.0, replaced by macro. | | | | | 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 | char *Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 { const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr) } # Removed in 9.0, replaced by macro. #declare 271 { # const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, # const char *version, int exact) #} declare 272 { const char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } # Removed in 9.0, replaced by 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 { # const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, # const char *version, int exact) #} # Removed in 9.0: #declare 275 { # void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) #} |
︙ | ︙ | |||
1163 1164 1165 1166 1167 1168 1169 | size_t Tcl_NumUtfChars(const char *src, size_t length) } declare 313 { size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, size_t charsToRead, int appendFlag) } # Removed in 9.0, replaced by macro. | | | | 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 | size_t Tcl_NumUtfChars(const char *src, size_t length) } declare 313 { size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, size_t charsToRead, int appendFlag) } # Removed in 9.0, replaced by macro. #declare 314 { # void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) #} # Removed in 9.0, replaced by macro. #declare 315 { # void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) #} declare 316 { int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name) } declare 317 { Tcl_Obj *Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, |
︙ | ︙ | |||
1252 1253 1254 1255 1256 1257 1258 | declare 339 { size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } # Removed in 9.0: | | | | 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 | declare 339 { size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } # Removed in 9.0: #declare 341 { # const char *Tcl_GetDefaultEncodingDir(void) #} # Removed in 9.0: #declare 342 { # void Tcl_SetDefaultEncodingDir(const char *path) #} declare 343 { void Tcl_AlertNotifier(void *clientData) } declare 344 { void Tcl_ServiceModeHook(int mode) |
︙ | ︙ | |||
1286 1287 1288 1289 1290 1291 1292 | } declare 350 { int Tcl_UniCharIsUpper(int ch) } declare 351 { int Tcl_UniCharIsWordChar(int ch) } | > | | < > > | | | < > | | 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 | } declare 350 { int Tcl_UniCharIsUpper(int ch) } declare 351 { int Tcl_UniCharIsWordChar(int ch) } # 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) } declare 355 { unsigned short *Tcl_UtfToChar16DString(const char *src, size_t length, Tcl_DString *dsPtr) } declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } # Removed in 9.0: #declare 357 { # Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, # int count) #} declare 358 { void Tcl_FreeParse(Tcl_Parse *parsePtr) } declare 359 { |
︙ | ︙ | |||
1395 1396 1397 1398 1399 1400 1401 | declare 380 { size_t Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 381 { int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index) } # Removed in 9.0, replaced by macro. | | > | | | < > | 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 | declare 380 { size_t Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 381 { int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index) } # Removed in 9.0, replaced by 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) } # 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) } declare 386 { void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr) } |
︙ | ︙ | |||
1527 1528 1529 1530 1531 1532 1533 | } declare 417 { void Tcl_ClearChannelHandlers(Tcl_Channel channel) } declare 418 { int Tcl_IsChannelExisting(const char *channelName) } | > | | | < > > | | | < > | 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 | } declare 417 { void Tcl_ClearChannelHandlers(Tcl_Channel channel) } declare 418 { int Tcl_IsChannelExisting(const char *channelName) } # 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) #} # Removed in 9.0, as it is actually a macro: #declare 422 { # Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, |
︙ | ︙ | |||
1593 1594 1595 1596 1597 1598 1599 | # introduced in 8.4a3 declare 434 { Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) } # TIP#15 (math function introspection) dkf # Removed in 9.0: | | | | 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 | # introduced in 8.4a3 declare 434 { Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) } # TIP#15 (math function introspection) dkf # Removed in 9.0: #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 { # Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) #} # TIP#36 (better access to 'subst') dkf declare 437 { Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
870 871 872 873 874 875 876 | #define TCL_NAMESPACE_ONLY 2 #define TCL_APPEND_VALUE 4 #define TCL_LIST_ELEMENT 8 #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 | | | 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 | #define TCL_NAMESPACE_ONLY 2 #define TCL_APPEND_VALUE 4 #define TCL_LIST_ELEMENT 8 #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 #ifndef TCL_REMOVE_OBSOLETE_TRACES /* Required to support old variable/vdelete/vinfo traces. */ #define TCL_TRACE_OLD_STYLE 0x1000 #endif /* Indicate the semantics of the result of a trace. */ |
︙ | ︙ | |||
1932 1933 1934 1935 1936 1937 1938 | #define TCL_CONVERT_MULTIBYTE (-1) #define TCL_CONVERT_SYNTAX (-2) #define TCL_CONVERT_UNKNOWN (-3) #define TCL_CONVERT_NOSPACE (-4) /* * The maximum number of bytes that are necessary to represent a single | | | | | < | | | | < < < < | 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 | #define TCL_CONVERT_MULTIBYTE (-1) #define TCL_CONVERT_SYNTAX (-2) #define TCL_CONVERT_UNKNOWN (-3) #define TCL_CONVERT_NOSPACE (-4) /* * The maximum number of bytes that are necessary to represent a single * 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 2-bytes in size (UCS-2) (the default). If > 3, * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode * is the default and recommended mode. */ #ifndef TCL_UTF_MAX #define TCL_UTF_MAX 3 #endif /* * This represents a Unicode character. Any changes to this should also be * reflected in regcustom.h. */ #if TCL_UTF_MAX > 3 /* * int isn't 100% accurate as it should be a strict 4-byte value * (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 typedef unsigned short Tcl_UniChar; #endif /* |
︙ | ︙ | |||
2137 2138 2139 2140 2141 2142 2143 | typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, int result); /* *---------------------------------------------------------------------------- * The following constant is used to test for older versions of Tcl in the | | | | 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 | typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, int result); /* *---------------------------------------------------------------------------- * The following constant is used to test for older versions of Tcl in the * stubs tables. */ #define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) /* * The following function is required to be defined in all stubs aware * extensions. The function is actually implemented in the stub library, not * the main Tcl library, although there is a trivial implementation in the * main library in case an extension is statically linked into an application. */ |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
1345 1346 1347 1348 1349 1350 1351 | badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch = 0; | | | 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 | badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch = 0; char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } |
︙ | ︙ | |||
1716 1717 1718 1719 1720 1721 1722 | badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch = 0; | | | 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 | badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch = 0; char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 | { int i, index, indices, length, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; int group, allocatedIndexVector = 0; size_t j, idx, groupSize, groupOffset; Tcl_WideInt wide; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; SortElement *elementArray = NULL, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ # define NUM_LISTS 30 SortElement *subList[NUM_LISTS+1]; /* This array holds pointers to temporary * lists built during the merge sort. Element * i of the array holds a list of length * 2**i. */ static const char *const switches[] = { | > > | 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 | { int i, index, indices, length, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; int group, allocatedIndexVector = 0; 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 * lists built during the merge sort. Element * i of the array holds a list of length * 2**i. */ static const char *const switches[] = { |
︙ | ︙ | |||
4320 4321 4322 4323 4324 4325 4326 | } /* * The following loop creates a SortElement for each list element and * begins sorting it into the sublists as it appears. */ | > > | > > > > > > > > > > | 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 | } /* * The following loop creates a SortElement for each list element and * begins sorting it into the sublists as it appears. */ 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; if (indexc) { /* * If this is an indexed sort, retrieve the corresponding element */ |
︙ | ︙ | |||
4453 4454 4455 4456 4457 4458 4459 | TclDecrRefCount(listObj); sortInfo.compareCmdPtr = NULL; } if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); } if (elementArray) { | > | > > > | 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 | TclDecrRefCount(listObj); sortInfo.compareCmdPtr = NULL; } if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); } if (elementArray) { if (elmArrSize <= MAXCALLOC) { Tcl_Free(elementArray); } else { free((char *)elementArray); } } return sortInfo.resultCode; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
602 603 604 605 606 607 608 | size_t slen; int nocase, wsrclc; int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); | | | | | | | 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 | size_t slen; int nocase, wsrclc; int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp; wsrc = TclGetUnicodeFromObj(objv[0], &slen); wstring = TclGetUnicodeFromObj(objv[1], &wlen); wsubspec = TclGetUnicodeFromObj(objv[2], &wsublen); wend = wstring + wlen - (slen ? slen - 1 : 0); result = TCL_OK; if (slen == 0) { /* * regsub behavior for "" matches between each character. 'string * map' skips the "" case. */ if (wstring < wend) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); for (; wstring < wend; wstring++) { TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); TclAppendUnicodeToObj(resultPtr, wstring, 1); numMatches++; } wlen = 0; } } else { wsrclc = Tcl_UniCharToLower(*wsrc); for (p = wfirstChar = wstring; wstring < wend; wstring++) { if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && (slen==1 || (strCmpFn(wstring, wsrc, slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); } if (p != wstring) { TclAppendUnicodeToObj(resultPtr, p, wstring - p); p = wstring + slen; } else { p += slen; } wstring = p - 1; TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); numMatches++; } } if (numMatches) { wlen = wfirstChar + wlen - p; wstring = p; } |
︙ | ︙ | |||
747 748 749 750 751 752 753 | Tcl_IncrRefCount(resultPtr); if (offset > TCL_INDEX_START) { /* * Copy the initial portion of the string in if an offset was * specified. */ | | | | 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 | Tcl_IncrRefCount(resultPtr); if (offset > TCL_INDEX_START) { /* * Copy the initial portion of the string in if an offset was * specified. */ TclAppendUnicodeToObj(resultPtr, wstring, offset); } } numMatches++; /* * Copy the portion of the source string before the match to the * result variable. */ Tcl_RegExpGetInfo(regExpr, &info); start = info.matches[0].start; end = info.matches[0].end; TclAppendUnicodeToObj(resultPtr, wstring + offset, start); /* * In command-prefix mode, the substitutions are added as quoted * arguments to the subSpec to form a command, that is then executed * and the result used as the string to substitute in. Actually, * everything is passed through Tcl_EvalObjv, as that's much faster. */ |
︙ | ︙ | |||
835 836 837 838 839 840 841 | * Always consume at least one character of the input string * in order to prevent infinite loops, even when we * technically matched the empty string; we must not match * again at the same spot. */ if (offset < wlen) { | | | 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 | * Always consume at least one character of the input string * in order to prevent infinite loops, even when we * technically matched the empty string; we must not match * again at the same spot. */ if (offset < wlen) { TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } if (all) { continue; } else { break; |
︙ | ︙ | |||
864 865 866 867 868 869 870 | idx = 0; } else if (ch == '\\') { ch = wsrc[1]; if ((ch >= '0') && (ch <= '9')) { idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; | | | | | | | | 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 | idx = 0; } else if (ch == '\\') { ch = wsrc[1]; if ((ch >= '0') && (ch <= '9')) { idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar + 1); *wsrc = '\\'; wfirstChar = wsrc + 2; wsrc++; continue; } else { continue; } } else { continue; } if (wfirstChar != wsrc) { TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { TclAppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } if (*wsrc == '\\') { wsrc++; } wfirstChar = wsrc + 1; } if (wfirstChar != wsrc) { TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (end == 0) { /* * Always consume at least one character of the input string in * order to prevent infinite loops. */ if (offset < wlen) { TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } else { offset += end; if (start == end) { /* * We matched an empty string, which means we must go forward * one more step so we don't match again at the same spot. */ if (offset < wlen) { TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } } if (!all) { break; } |
︙ | ︙ | |||
945 946 947 948 949 950 951 | * On zero matches, just ignore the offset, since it shouldn't matter * to us in this case, and the user may have skewed it. */ resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { | | | 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 | * On zero matches, just ignore the offset, since it shouldn't matter * to us in this case, and the user may have skewed it. */ resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (objc == 4) { if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } else { /* |
︙ | ︙ | |||
1218 1219 1220 1221 1222 1223 1224 | Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { int fullchar; len = TclUtfToUniChar(stringPtr, &ch); fullchar = ch; | | | 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 | Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { int fullchar; len = TclUtfToUniChar(stringPtr, &ch); fullchar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(stringPtr + len, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif /* |
︙ | ︙ | |||
1910 1911 1912 1913 1914 1915 1916 | goto str_is_done; } end = string1 + length1; for (; string1 < end; string1 += length2, failat++) { int fullchar; length2 = TclUtfToUniChar(string1, &ch); fullchar = ch; | | | 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 | goto str_is_done; } end = string1 + length1; for (; string1 < end; string1 += length2, failat++) { int fullchar; length2 = TclUtfToUniChar(string1, &ch); fullchar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (length2 < 3)) { length2 += TclUtfToUniChar(string1 + length2, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif if (!chcomp(fullchar)) { result = 0; |
︙ | ︙ | |||
2091 2092 2093 2094 2095 2096 2097 | * Empty input string, just stop now. */ goto done; } end = ustring1 + length1; | | | 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 | * Empty input string, just stop now. */ goto done; } end = ustring1 + length1; strCmpFn = (nocase ? TclUniCharNcasecmp : TclUniCharNcmp); /* * Force result to be Unicode */ resultPtr = Tcl_NewUnicodeObj(ustring1, 0); |
︙ | ︙ | |||
2128 2129 2130 2131 2132 2133 2134 | u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, length2) == 0)) { if (p != ustring1) { | | | | 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 | u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, length2) == 0)) { if (p != ustring1) { TclAppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; TclAppendUnicodeToObj(resultPtr, mapString, mapLen); } } } } else { Tcl_UniChar **mapStrings; size_t *mapLens; int *u2lc = 0; |
︙ | ︙ | |||
2181 2182 2183 2184 2185 2186 2187 | ((size_t)(end-ustring1) >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. */ | | | | | 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 | ((size_t)(end-ustring1) >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. */ TclAppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } /* * Adjust len to be full length of matched string. */ ustring1 = p - 1; /* * Append the map value to the unicode string. */ TclAppendUnicodeToObj(resultPtr, mapStrings[index+1], mapLens[index+1]); break; } } } if (nocase) { TclStackFree(interp, u2lc); } TclStackFree(interp, mapLens); TclStackFree(interp, mapStrings); } if (p != ustring1) { /* * Put the rest of the unmapped chars onto result. */ TclAppendUnicodeToObj(resultPtr, p, ustring1 - p); } Tcl_SetObjResult(interp, resultPtr); done: if (mapWithDict) { TclStackFree(interp, mapElemv); } if (copySource) { |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
938 939 940 941 942 943 944 | EXTERN int Tcl_UniCharIsLower(int ch); /* 349 */ EXTERN int Tcl_UniCharIsSpace(int ch); /* 350 */ EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); | | < | < < | 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 | EXTERN int Tcl_UniCharIsLower(int ch); /* 349 */ EXTERN int Tcl_UniCharIsSpace(int ch); /* 350 */ EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); /* Slot 352 is reserved */ /* Slot 353 is reserved */ /* 354 */ EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 355 */ EXTERN unsigned short * Tcl_UtfToChar16DString(const char *src, size_t length, Tcl_DString *dsPtr); /* 356 */ |
︙ | ︙ | |||
1025 1026 1027 1028 1029 1030 1031 | EXTERN size_t Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); /* Slot 382 is reserved */ /* 383 */ EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last); | | < < | 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 | EXTERN size_t Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); /* Slot 382 is reserved */ /* 383 */ EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last); /* Slot 384 is reserved */ /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 386 */ EXTERN void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr); /* 387 */ EXTERN Tcl_Mutex * Tcl_GetAllocMutex(void); |
︙ | ︙ | |||
1117 1118 1119 1120 1121 1122 1123 | EXTERN void Tcl_CutChannel(Tcl_Channel channel); /* 416 */ EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); /* 417 */ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ EXTERN int Tcl_IsChannelExisting(const char *channelName); | | < < | < < | 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 | EXTERN void Tcl_CutChannel(Tcl_Channel channel); /* 416 */ EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); /* 417 */ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ EXTERN int Tcl_IsChannelExisting(const char *channelName); /* Slot 419 is reserved */ /* Slot 420 is reserved */ /* Slot 421 is reserved */ /* Slot 422 is reserved */ /* 423 */ EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 424 */ EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); |
︙ | ︙ | |||
2150 2151 2152 2153 2154 2155 2156 | int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ int (*tcl_UniCharIsAlpha) (int ch); /* 346 */ int (*tcl_UniCharIsDigit) (int ch); /* 347 */ int (*tcl_UniCharIsLower) (int ch); /* 348 */ int (*tcl_UniCharIsSpace) (int ch); /* 349 */ int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ | | | | 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 | int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ int (*tcl_UniCharIsAlpha) (int ch); /* 346 */ int (*tcl_UniCharIsDigit) (int ch); /* 347 */ int (*tcl_UniCharIsLower) (int ch); /* 348 */ int (*tcl_UniCharIsSpace) (int ch); /* 349 */ int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ 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 */ void (*reserved357)(void); void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, size_t length); /* 359 */ int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ |
︙ | ︙ | |||
2182 2183 2184 2185 2186 2187 2188 | void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, size_t numChars); /* 378 */ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); /* 379 */ size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ 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 */ | | | 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 | void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, size_t numChars); /* 378 */ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); /* 379 */ size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ 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 (*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 */ int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */ int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */ int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */ |
︙ | ︙ | |||
2217 2218 2219 2220 2221 2222 2223 | int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */ int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */ int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */ void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */ void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ | | | | 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 | int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */ int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */ int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */ void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */ void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ 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 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */ int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 426 */ void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ |
︙ | ︙ | |||
3135 3136 3137 3138 3139 3140 3141 | (tclStubsPtr->tcl_UniCharIsLower) /* 348 */ #define Tcl_UniCharIsSpace \ (tclStubsPtr->tcl_UniCharIsSpace) /* 349 */ #define Tcl_UniCharIsUpper \ (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ | < | < | | 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 | (tclStubsPtr->tcl_UniCharIsLower) /* 348 */ #define Tcl_UniCharIsSpace \ (tclStubsPtr->tcl_UniCharIsSpace) /* 349 */ #define Tcl_UniCharIsUpper \ (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ /* Slot 352 is reserved */ /* Slot 353 is reserved */ #define Tcl_Char16ToUtfDString \ (tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */ #define Tcl_UtfToChar16DString \ (tclStubsPtr->tcl_UtfToChar16DString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ /* Slot 357 is reserved */ |
︙ | ︙ | |||
3197 3198 3199 3200 3201 3202 3203 | #define Tcl_GetCharLength \ (tclStubsPtr->tcl_GetCharLength) /* 380 */ #define Tcl_GetUniChar \ (tclStubsPtr->tcl_GetUniChar) /* 381 */ /* Slot 382 is reserved */ #define Tcl_GetRange \ (tclStubsPtr->tcl_GetRange) /* 383 */ | < | | 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 | #define Tcl_GetCharLength \ (tclStubsPtr->tcl_GetCharLength) /* 380 */ #define Tcl_GetUniChar \ (tclStubsPtr->tcl_GetUniChar) /* 381 */ /* Slot 382 is reserved */ #define Tcl_GetRange \ (tclStubsPtr->tcl_GetRange) /* 383 */ /* Slot 384 is reserved */ #define Tcl_RegExpMatchObj \ (tclStubsPtr->tcl_RegExpMatchObj) /* 385 */ #define Tcl_SetNotifier \ (tclStubsPtr->tcl_SetNotifier) /* 386 */ #define Tcl_GetAllocMutex \ (tclStubsPtr->tcl_GetAllocMutex) /* 387 */ #define Tcl_GetChannelNames \ |
︙ | ︙ | |||
3267 3268 3269 3270 3271 3272 3273 | (tclStubsPtr->tcl_CutChannel) /* 415 */ #define Tcl_SpliceChannel \ (tclStubsPtr->tcl_SpliceChannel) /* 416 */ #define Tcl_ClearChannelHandlers \ (tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */ #define Tcl_IsChannelExisting \ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ | < | < | | 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 | (tclStubsPtr->tcl_CutChannel) /* 415 */ #define Tcl_SpliceChannel \ (tclStubsPtr->tcl_SpliceChannel) /* 416 */ #define Tcl_ClearChannelHandlers \ (tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */ #define Tcl_IsChannelExisting \ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ /* Slot 419 is reserved */ /* Slot 420 is reserved */ /* Slot 421 is reserved */ /* Slot 422 is reserved */ #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #define Tcl_InitObjHashTable \ (tclStubsPtr->tcl_InitObjHashTable) /* 424 */ #define Tcl_CommandTraceInfo \ |
︙ | ︙ | |||
3870 3871 3872 3873 3874 3875 3876 | #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) #define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value)) #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) #define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) | | | 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 | #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) #define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value)) #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) #define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_UTF_MAX <= 3 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString # undef Tcl_UtfToUniCharDString # define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString # undef Tcl_UtfToUniChar # define Tcl_UtfToUniChar Tcl_UtfToChar16 #endif |
︙ | ︙ |
Changes to generic/tclDisassemble.c.
︙ | ︙ | |||
898 899 900 901 902 903 904 | i += 2; continue; case '\v': Tcl_AppendToObj(appendObj, "\\v", -1); i += 2; continue; default: | | | 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 | i += 2; continue; case '\v': Tcl_AppendToObj(appendObj, "\\v", -1); i += 2; continue; default: #if TCL_UTF_MAX > 3 if (ch > 0xffff) { Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch); i += 10; } else #else /* If len == 0, this means we have a char > 0xffff, resulting in * TclUtfToUniChar producing a surrogate pair. We want to output |
︙ | ︙ |
Changes to generic/tclEncoding.c.
︙ | ︙ | |||
2549 2550 2551 2552 2553 2554 2555 | /* * Need to handle this in a way that won't cause misalignment by * casting dst to a Tcl_UniChar. [Bug 1122671] */ if (clientData) { | | | | 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 | /* * Need to handle this in a way that won't cause misalignment by * casting dst to a Tcl_UniChar. [Bug 1122671] */ if (clientData) { #if TCL_UTF_MAX > 3 if (*chPtr <= 0xFFFF) { *dst++ = (*chPtr & 0xFF); *dst++ = (*chPtr >> 8); } else { *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF); *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; *dst++ = (*chPtr & 0xFF); *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC; } #else *dst++ = (*chPtr & 0xFF); *dst++ = (*chPtr >> 8); #endif } else { #if TCL_UTF_MAX > 3 if (*chPtr <= 0xFFFF) { *dst++ = (*chPtr >> 8); *dst++ = (*chPtr & 0xFF); } else { *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC; *dst++ = (*chPtr & 0xFF); *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; |
︙ | ︙ | |||
2631 2632 2633 2634 2635 2636 2637 | * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; | | | 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 | * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; #if TCL_UTF_MAX <= 3 int len; #endif Tcl_UniChar ch = 0; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; |
︙ | ︙ | |||
2661 2662 2663 2664 2665 2666 2667 | result = TCL_CONVERT_MULTIBYTE; break; } if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } | | | 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 | result = TCL_CONVERT_MULTIBYTE; break; } if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } #if TCL_UTF_MAX <= 3 src += (len = TclUtfToUniChar(src, &ch)); if ((ch >= 0xD800) && (len < 3)) { src += TclUtfToUniChar(src, &ch); ch = 0xFFFD; } #else src += TclUtfToUniChar(src, &ch); |
︙ | ︙ | |||
2885 2886 2887 2888 2889 2890 2891 | */ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); | | | 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 | */ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); #if TCL_UTF_MAX > 3 /* * This prevents a crash condition. More evaluation is required for * full support of int Tcl_UniChar. [Bug 1004065] */ if (ch & 0xffff0000) { word = 0; |
︙ | ︙ | |||
3096 3097 3098 3099 3100 3101 3102 | len = TclUtfToUniChar(src, &ch); /* * Check for illegal characters. */ if (ch > 0xff | | | | 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 | len = TclUtfToUniChar(src, &ch); /* * Check for illegal characters. */ if (ch > 0xff #if TCL_UTF_MAX <= 3 || ((ch >= 0xD800) && (len < 3)) #endif ) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) len = 4; #endif /* * Plunge on, using '?' as a fallback character. */ ch = (Tcl_UniChar) '?'; |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | #ifndef TCL_COMPILE_DEBUG #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ | > > > > > > > > > > | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 | #ifndef TCL_COMPILE_DEBUG #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ 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); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ break; \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ 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); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ |
︙ | ︙ | |||
2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 | (void) POP_OBJECT(); goto abnormalReturn; case INST_PUSH4: objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); NEXT_INST_F(5, 0, 1); case INST_POP: TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); NEXT_INST_F(1, 0, 0); case INST_DUP: objResultPtr = OBJ_AT_TOS; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_F(5, 0, 1); case INST_REVERSE: { Tcl_Obj **a, **b; opnd = TclGetUInt4AtPtr(pc+1); a = tosPtr-(opnd-1); b = tosPtr; | > > > > | 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 | (void) POP_OBJECT(); goto abnormalReturn; case INST_PUSH4: 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; opnd = TclGetUInt4AtPtr(pc+1); a = tosPtr-(opnd-1); b = tosPtr; |
︙ | ︙ | |||
2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 | if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); case INST_CONCAT_STK: /* * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj, * and then decrement their ref counts. */ opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); case INST_EXPAND_START: /* * Push an element to the auxObjList. This records the current * stack depth - i.e., the point in the stack where the expanded * command starts. * | > > | 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 | if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); break; case INST_CONCAT_STK: /* * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj, * and then decrement their ref counts. */ opnd = TclGetUInt4AtPtr(pc+1); 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: /* * Push an element to the auxObjList. This records the current * stack depth - i.e., the point in the stack where the expanded * command starts. * |
︙ | ︙ | |||
2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 | TclNewObj(objPtr); objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH); objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH)); NEXT_INST_F(1, 0, 0); case INST_EXPAND_DROP: /* * Drops an element of the auxObjList, popping stack elements to * restore the stack to the state before the point where the aux * element was created. */ | > | 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 | TclNewObj(objPtr); objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH); objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH)); NEXT_INST_F(1, 0, 0); break; case INST_EXPAND_DROP: /* * Drops an element of the auxObjList, popping stack elements to * restore the stack to the state before the point where the aux * element was created. */ |
︙ | ︙ | |||
2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 | /* * Nothing was expanded, return {}. */ TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doInvocation; case INST_INVOKE_STK1: | > | 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 | /* * Nothing was expanded, return {}. */ TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doInvocation; case INST_INVOKE_STK1: |
︙ | ︙ | |||
4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 | */ case INST_JUMP1: opnd = TclGetInt1AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); case INST_JUMP4: opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); | > | 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 | */ case INST_JUMP1: opnd = TclGetInt1AtPtr(pc+1); 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); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); |
︙ | ︙ | |||
4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 | NEXT_INST_F(1, 0, 1); } break; case INST_INFO_LEVEL_NUM: TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { int level; CallFrame *framePtr = iPtr->varFramePtr; CallFrame *rootFramePtr = iPtr->rootFramePtr; TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { | > | 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 | NEXT_INST_F(1, 0, 1); } break; case INST_INFO_LEVEL_NUM: 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; CallFrame *rootFramePtr = iPtr->rootFramePtr; TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { |
︙ | ︙ | |||
5255 5256 5257 5258 5259 5260 5261 | p = ustring1; end = ustring1 + slength; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { | | | | | 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 | p = ustring1; end = ustring1 + slength; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { TclAppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; TclAppendUnicodeToObj(objResultPtr, ustring3, length3); } } if (p != ustring1) { /* * Put the rest of the unmapped chars onto result. */ TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p); } doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); case INST_STR_FIND: |
︙ | ︙ | |||
5449 5450 5451 5452 5453 5454 5455 | /* * Peep-hole optimisation: if you're about to jump, do jump from here. * Adjustment is 2 due to the nocase byte. */ JUMP_PEEPHOLE_F(match, 2, 2); } | < | 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 | /* * Peep-hole optimisation: if you're about to jump, do jump from here. * Adjustment is 2 due to the nocase byte. */ JUMP_PEEPHOLE_F(match, 2, 2); } /* * End of string-related instructions. * ----------------------------------------------------------------- * Start of numeric operator instructions. */ |
︙ | ︙ | |||
5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 | objResultPtr = Tcl_NewWideIntObj(wResult); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } TclSetIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); case INST_DIV: if (w2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); goto divideByZero; } else if ((w1 == WIDE_MIN) && (w2 == -1)) { | > | 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 | objResultPtr = Tcl_NewWideIntObj(wResult); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } TclSetIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); break; case INST_DIV: if (w2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); goto divideByZero; } else if ((w1 == WIDE_MIN) && (w2 == -1)) { |
︙ | ︙ | |||
6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 | goto gotError; } switch (type1) { case TCL_NUMBER_NAN: /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); case TCL_NUMBER_INT: w1 = *((const Tcl_WideInt *) ptr1); if (w1 != WIDE_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewIntObj(objResultPtr, -w1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); | > | 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 | goto gotError; } switch (type1) { case TCL_NUMBER_NAN: /* -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) { if (Tcl_IsShared(valuePtr)) { TclNewIntObj(objResultPtr, -w1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); |
︙ | ︙ | |||
6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 | objResultPtr = TCONST(1); } else { int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK); objResultPtr = TCONST(result); } TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_BREAK: /* DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); */ | > | 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 | objResultPtr = TCONST(1); } else { int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK); objResultPtr = TCONST(result); } TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_BREAK: /* DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); */ |
︙ | ︙ | |||
6374 6375 6376 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 | */ *(++catchTop) = CURR_DEPTH; TRACE(("%u => catchTop=%d, stackTop=%d\n", TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1), (int) CURR_DEPTH)); NEXT_INST_F(5, 0, 0); case INST_END_CATCH: catchTop--; DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); result = TCL_OK; TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1))); NEXT_INST_F(1, 0, 0); case INST_PUSH_RESULT: objResultPtr = Tcl_GetObjResult(interp); TRACE_WITH_OBJ(("=> "), objResultPtr); /* * See the comments at INST_INVOKE_STK */ TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: TclNewIntObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); case INST_PUSH_RETURN_OPTIONS: DECACHE_STACK_INFO(); objResultPtr = Tcl_GetReturnOptions(interp, result); CACHE_STACK_INFO(); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_RETURN_CODE_BRANCH: { int code; if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) { Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS not a return code!"); } | > > > > > | 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 | */ *(++catchTop) = CURR_DEPTH; TRACE(("%u => catchTop=%d, stackTop=%d\n", TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1), (int) CURR_DEPTH)); NEXT_INST_F(5, 0, 0); break; case INST_END_CATCH: catchTop--; DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); 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); TRACE_WITH_OBJ(("=> "), objResultPtr); /* * See the comments at INST_INVOKE_STK */ TclNewObj(objPtr); 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(); objResultPtr = Tcl_GetReturnOptions(interp, result); CACHE_STACK_INFO(); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_RETURN_CODE_BRANCH: { int code; if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) { Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS not a return code!"); } |
︙ | ︙ | |||
6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 | if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) { TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n", O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); case INST_DICT_EXISTS: { int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = OBJ_AT_DEPTH(opnd); | > | 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 | if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) { TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n", O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); break; case INST_DICT_EXISTS: { int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = OBJ_AT_DEPTH(opnd); |
︙ | ︙ | |||
8448 8449 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 | compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); return compare; } case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); switch (type2) { case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); doubleCompare: | > | 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 | compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); return compare; } break; case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); switch (type2) { case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); doubleCompare: |
︙ | ︙ | |||
8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 | d2 = TclBignumToDouble(&big2); mp_clear(&big2); goto doubleCompare; } Tcl_InitBignumFromDouble(NULL, d1, &big1); goto bigCompare; } case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { case TCL_NUMBER_INT: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); | > | 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 | d2 = TclBignumToDouble(&big2); mp_clear(&big2); goto doubleCompare; } Tcl_InitBignumFromDouble(NULL, d1, &big1); goto bigCompare; } break; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { case TCL_NUMBER_INT: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); |
︙ | ︙ | |||
8530 8531 8532 8533 8534 8535 8536 8537 8538 | Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); bigCompare: compare = mp_cmp(&big1, &big2); mp_clear(&big1); mp_clear(&big2); return compare; } default: Tcl_Panic("unexpected number type"); | > < > | 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 | Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); bigCompare: compare = mp_cmp(&big1, &big2); mp_clear(&big1); mp_clear(&big2); return compare; } break; default: Tcl_Panic("unexpected number type"); } return TCL_ERROR; } #ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * * PrintByteCodeInfo -- |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
4717 4718 4719 4720 4721 4722 4723 | int rawRead; char tmp[TCL_UTF_MAX]; bufPtr = gs.bufPtr; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp, | | | 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 | int rawRead; char tmp[TCL_UTF_MAX]; bufPtr = gs.bufPtr; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp, sizeof(tmp), &rawRead, NULL, NULL); bufPtr->nextRemoved += rawRead; gs.rawRead -= rawRead; gs.bytesWrote--; gs.charsWrote--; memmove(dst, dst + 1, dstEnd - dst); dstEnd--; } |
︙ | ︙ | |||
6282 6283 6284 6285 6286 6287 6288 | assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0 || 0 == (statePtr->inputEncodingFlags & TCL_ENCODING_END)); Tcl_ExternalToUtf(NULL, encoding, src, srcLen, (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE), | | | 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 | assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0 || 0 == (statePtr->inputEncodingFlags & TCL_ENCODING_END)); Tcl_ExternalToUtf(NULL, encoding, src, srcLen, (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE), &statePtr->inputEncodingState, buffer, sizeof(buffer), &read, &decoded, &count); if (count == 2) { if (buffer[1] == '\n') { /* \r\n translate to \n */ dst[0] = '\n'; bufPtr->nextRemoved += read; |
︙ | ︙ |
Changes to generic/tclInt.decls.
︙ | ︙ | |||
1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 | } # TIP 431: temporary directory creation function declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } declare 259 { int TclMSB(size_t n) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. | > > > > > | 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 | } # TIP 431: temporary directory creation function 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) } declare 260 { int TclMSB(size_t n) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 | */ MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); /* * Just for the purposes of command-type registration. */ MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd; MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd; | > > > > > > > > > > > > > | 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 | */ MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, 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. */ MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd; MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd; |
︙ | ︙ | |||
4659 4660 4661 4662 4663 4664 4665 | * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ | | | 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 | * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ #if TCL_UTF_MAX > 3 #define TclUtfToUniChar(str, chPtr) \ ((((unsigned char) *(str)) < 0x80) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ : Tcl_UtfToUniChar(str, chPtr)) #else #define TclUtfToUniChar(str, chPtr) \ ((((unsigned char) *(str)) < 0x80) ? \ |
︙ | ︙ | |||
4733 4734 4735 4736 4737 4738 4739 | * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, * const Tcl_UniChar *ct, unsigned long n); *---------------------------------------------------------------- */ #ifdef WORDS_BIGENDIAN # define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) | < < | 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 | * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, * const Tcl_UniChar *ct, unsigned long n); *---------------------------------------------------------------- */ #ifdef WORDS_BIGENDIAN # define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) #endif /* WORDS_BIGENDIAN */ /* *---------------------------------------------------------------- * Macro used by the Tcl core to increment a namespace's export epoch * counter. The ANSI C "prototype" for this macro is: * |
︙ | ︙ |
Changes to generic/tclIntDecls.h.
︙ | ︙ | |||
578 579 580 581 582 583 584 585 586 587 588 589 590 591 | const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 259 */ EXTERN int TclMSB(size_t n); typedef struct TclIntStubs { int magic; void *hooks; void (*reserved0)(void); | > > > | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 | const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 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); /* 260 */ EXTERN int TclMSB(size_t n); typedef struct TclIntStubs { int magic; void *hooks; void (*reserved0)(void); |
︙ | ︙ | |||
843 844 845 846 847 848 849 | Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ 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 */ | > | | 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 | Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ 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 */ int (*tclMSB) (size_t n); /* 260 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
1261 1262 1263 1264 1265 1266 1267 1268 | (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ #define TclMSB \ | > > | | 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 | (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ #define TclAppendUnicodeToObj \ (tclIntStubsPtr->tclAppendUnicodeToObj) /* 259 */ #define TclMSB \ (tclIntStubsPtr->tclMSB) /* 260 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) #undef Tcl_StaticPackage |
︙ | ︙ |
Changes to generic/tclLoad.c.
︙ | ︙ | |||
878 879 880 881 882 883 884 | if (ipPtr->pkgPtr == defaultPtr) { ipFirstPtr = ipFirstPtr->nextPtr; } else { InterpPackage *ipPrevPtr; for (ipPrevPtr = ipPtr; ipPtr != NULL; ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { | | | 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 | if (ipPtr->pkgPtr == defaultPtr) { ipFirstPtr = ipFirstPtr->nextPtr; } else { InterpPackage *ipPrevPtr; for (ipPrevPtr = ipPtr; ipPtr != NULL; ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == defaultPtr) { ipPrevPtr->nextPtr = ipPtr->nextPtr; break; } } } Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); |
︙ | ︙ |
Changes to generic/tclParse.c.
︙ | ︙ | |||
1412 1413 1414 1415 1416 1417 1418 | * special, we shouldn't break up a correct utf-8 character. [Bug * #217987] test subst-3.2 */ if (Tcl_UtfCharComplete(p, numBytes - 1)) { count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */ } else { | | | 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 | * special, we shouldn't break up a correct utf-8 character. [Bug * #217987] test subst-3.2 */ if (Tcl_UtfCharComplete(p, numBytes - 1)) { count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */ } else { char utfBytes[4]; memcpy(utfBytes, p, numBytes - 1); utfBytes[numBytes - 1] = '\0'; count = TclUtfToUniChar(utfBytes, &unichar) + 1; } result = unichar; break; |
︙ | ︙ |
Changes to generic/tclScan.c.
︙ | ︙ | |||
261 262 263 264 265 266 267 | Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ | | | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 | Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ char buf[5] = ""; /* * Initialize an array that records the number of times a variable is * assigned to by the format string. We use this to detect if a variable * is multiply assigned or left unassigned. */ |
︙ | ︙ | |||
873 874 875 876 877 878 879 | case 'c': /* * Scan a single Unicode character. */ offset = TclUtfToUniChar(string, &sch); i = (int)sch; | | | 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 | case 'c': /* * Scan a single Unicode character. */ offset = TclUtfToUniChar(string, &sch); i = (int)sch; #if TCL_UTF_MAX <= 3 if ((sch >= 0xD800) && (offset < 3)) { offset += TclUtfToUniChar(string+offset, &sch); i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF); } #endif string += offset; if (!(flags & SCAN_SUPPRESS)) { |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
549 550 551 552 553 554 555 | stringPtr = GET_STRING(objPtr); } if (index >= stringPtr->numChars) { return -1; } ch = stringPtr->unicode[index]; | | | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 | stringPtr = GET_STRING(objPtr); } if (index >= stringPtr->numChars) { return -1; } ch = stringPtr->unicode[index]; #if TCL_UTF_MAX <= 3 /* See: bug [11ae2be95dac9417] */ if ((ch & 0xF800) == 0xD800) { if (ch & 0x400) { if ((index > 0) && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) { ch = -1; /* low surrogate preceded by high surrogate */ } |
︙ | ︙ | |||
706 707 708 709 710 711 712 | } if (last > stringPtr->numChars) { last = stringPtr->numChars; } if (last < first) { return Tcl_NewObj(); } | | | 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 | } if (last > stringPtr->numChars) { last = stringPtr->numChars; } if (last < first) { return Tcl_NewObj(); } #if TCL_UTF_MAX <= 3 /* See: bug [11ae2be95dac9417] */ if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } if ((last + 2 < stringPtr->numChars + 1) && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) |
︙ | ︙ | |||
1161 1162 1163 1164 1165 1166 1167 | { Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_AUTO_LENGTH, NULL); } /* *---------------------------------------------------------------------- * | | | | | 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 | { Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_AUTO_LENGTH, NULL); } /* *---------------------------------------------------------------------- * * TclAppendUnicodeToObj -- * * This function appends a Unicode string to an object in the most * efficient manner possible. Length must be >= 0. * * Results: * None. * * Side effects: * Invalidates the string rep and creates a new Unicode string. * *---------------------------------------------------------------------- */ void TclAppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ size_t length) /* Number of chars in "unicode". */ { String *stringPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "TclAppendUnicodeToObj"); } if (length == 0) { return; } SetStringFromAny(NULL, objPtr); |
︙ | ︙ | |||
2505 2506 2507 2508 2509 2510 2511 | */ q = Tcl_UtfPrev(end, bytes); if (!Tcl_UtfCharComplete(q, (end - q))) { end = q; } | | | 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 | */ q = Tcl_UtfPrev(end, bytes); if (!Tcl_UtfCharComplete(q, (end - q))) { end = q; } q = bytes + 4; while ((bytes < end) && (bytes < q) && ((*bytes & 0xC0) == 0x80)) { bytes++; } Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(bytes , (end - bytes))); |
︙ | ︙ | |||
2828 2829 2830 2831 2832 2833 2834 | return NULL; } Tcl_SetObjLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } | | | 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 | return NULL; } Tcl_SetObjLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } TclAppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), (count - done) * length); } else { /* * Efficiently concatenate string reps. */ if (!inPlace || Tcl_IsShared(objPtr)) { |
︙ | ︙ | |||
3295 3296 3297 3298 3299 3300 3301 | * memcmp. In benchmark testing this proved the most efficient * check between the unicode and string comparison operations. */ if (nocase) { s1 = (char *) TclGetUnicodeFromObj(value1Ptr, &s1len); s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len); | | | 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 | * memcmp. In benchmark testing this proved the most efficient * check between the unicode and string comparison operations. */ if (nocase) { s1 = (char *) TclGetUnicodeFromObj(value1Ptr, &s1len); s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len); memCmpFn = (memCmpFn_t)TclUniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); if ((s1len == value1Ptr->length) && (value1Ptr->bytes != NULL) && (s2len == value2Ptr->length) && (value2Ptr->bytes != NULL)) { |
︙ | ︙ | |||
3320 3321 3322 3323 3324 3325 3326 | checkEq #endif ) { memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); } else { | | | 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 | checkEq #endif ) { memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); } else { memCmpFn = (memCmpFn_t) TclUniCharNcmp; } } } } else { empty = TclCheckEmptyString(value1Ptr); if (empty > 0) { switch (TclCheckEmptyString(value2Ptr)) { |
︙ | ︙ | |||
3885 3886 3887 3888 3889 3890 3891 | /* TODO: Is there an in-place option worth pursuing here? */ result = Tcl_NewUnicodeObj(ustring, first); if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } if (first + count < (size_t)numChars) { | | | 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 | /* TODO: Is there an in-place option worth pursuing here? */ result = Tcl_NewUnicodeObj(ustring, first); if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } if (first + count < (size_t)numChars) { TclAppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } return result; } } |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
36 37 38 39 40 41 42 43 44 45 46 47 48 49 | #undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_DbNewLongObj #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_GetUnicode #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry #undef Tcl_Panic #undef Tcl_FindExecutable #undef Tcl_SetExitProc | > > > | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | #undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_DbNewLongObj #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 #undef Tcl_CreateHashEntry #undef Tcl_Panic #undef Tcl_FindExecutable #undef Tcl_SetExitProc |
︙ | ︙ | |||
59 60 61 62 63 64 65 66 67 68 69 70 71 72 | #undef TclWinNToHS #undef TclStaticPackage #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar #define TclBN_mp_add mp_add #define TclBN_mp_add_d mp_add_d #define TclBN_mp_and mp_and #define TclBN_mp_clamp mp_clamp #define TclBN_mp_clear mp_clear #define TclBN_mp_clear_multi mp_clear_multi | > > > > > > > > > > | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | #undef TclWinNToHS #undef TclStaticPackage #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage #undef Tcl_UniCharToUtfDString #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 #define TclBN_mp_clamp mp_clamp #define TclBN_mp_clear mp_clear #define TclBN_mp_clear_multi mp_clear_multi |
︙ | ︙ | |||
214 215 216 217 218 219 220 | "integer value too large to represent as non-long integer", -1)); result = TCL_ERROR; } } return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj | < < < < < < < < | 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | "integer value too large to represent as non-long integer", -1)); result = TCL_ERROR; } } return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj 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))(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))(void *)utfNcasecmp #endif /* TCL_WIDE_INT_IS_LONG */ #endif /* __CYGWIN__ */ /* * WARNING: The contents of this file is automatically generated by the |
︙ | ︙ | |||
517 518 519 520 521 522 523 | TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ | > | | 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ TclAppendUnicodeToObj, /* 259 */ TclMSB, /* 260 */ }; static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ |
︙ | ︙ | |||
1104 1105 1106 1107 1108 1109 1110 | Tcl_UniCharIsAlnum, /* 345 */ Tcl_UniCharIsAlpha, /* 346 */ Tcl_UniCharIsDigit, /* 347 */ Tcl_UniCharIsLower, /* 348 */ Tcl_UniCharIsSpace, /* 349 */ Tcl_UniCharIsUpper, /* 350 */ Tcl_UniCharIsWordChar, /* 351 */ | | | | 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 | Tcl_UniCharIsAlnum, /* 345 */ Tcl_UniCharIsAlpha, /* 346 */ Tcl_UniCharIsDigit, /* 347 */ Tcl_UniCharIsLower, /* 348 */ Tcl_UniCharIsSpace, /* 349 */ Tcl_UniCharIsUpper, /* 350 */ Tcl_UniCharIsWordChar, /* 351 */ 0, /* 352 */ 0, /* 353 */ Tcl_Char16ToUtfDString, /* 354 */ Tcl_UtfToChar16DString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ 0, /* 357 */ Tcl_FreeParse, /* 358 */ Tcl_LogCommandInfo, /* 359 */ Tcl_ParseBraces, /* 360 */ |
︙ | ︙ | |||
1136 1137 1138 1139 1140 1141 1142 | Tcl_RegExpGetInfo, /* 377 */ Tcl_NewUnicodeObj, /* 378 */ Tcl_SetUnicodeObj, /* 379 */ Tcl_GetCharLength, /* 380 */ Tcl_GetUniChar, /* 381 */ 0, /* 382 */ Tcl_GetRange, /* 383 */ | | | 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 | Tcl_RegExpGetInfo, /* 377 */ Tcl_NewUnicodeObj, /* 378 */ Tcl_SetUnicodeObj, /* 379 */ Tcl_GetCharLength, /* 380 */ Tcl_GetUniChar, /* 381 */ 0, /* 382 */ Tcl_GetRange, /* 383 */ 0, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ Tcl_SetNotifier, /* 386 */ Tcl_GetAllocMutex, /* 387 */ Tcl_GetChannelNames, /* 388 */ Tcl_GetChannelNamesEx, /* 389 */ Tcl_ProcObjCmd, /* 390 */ Tcl_ConditionFinalize, /* 391 */ |
︙ | ︙ | |||
1171 1172 1173 1174 1175 1176 1177 | Tcl_JoinThread, /* 412 */ Tcl_IsChannelShared, /* 413 */ Tcl_IsChannelRegistered, /* 414 */ Tcl_CutChannel, /* 415 */ Tcl_SpliceChannel, /* 416 */ Tcl_ClearChannelHandlers, /* 417 */ Tcl_IsChannelExisting, /* 418 */ | | | | 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 | Tcl_JoinThread, /* 412 */ Tcl_IsChannelShared, /* 413 */ Tcl_IsChannelRegistered, /* 414 */ Tcl_CutChannel, /* 415 */ Tcl_SpliceChannel, /* 416 */ Tcl_ClearChannelHandlers, /* 417 */ Tcl_IsChannelExisting, /* 418 */ 0, /* 419 */ 0, /* 420 */ 0, /* 421 */ 0, /* 422 */ Tcl_InitCustomHashTable, /* 423 */ Tcl_InitObjHashTable, /* 424 */ Tcl_CommandTraceInfo, /* 425 */ Tcl_TraceCommand, /* 426 */ Tcl_UntraceCommand, /* 427 */ |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
1403 1404 1405 1406 1407 1408 1409 | } if ((i < 0) || (i > length)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; } | | | 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 | } if ((i < 0) || (i > length)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; } TclAppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; } return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclTrace.c.
︙ | ︙ | |||
75 76 77 78 79 80 81 | * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags. * TCL_TRACE_EXEC_IN_PROGRESS - The callback function on this trace is * currently executing. Therefore we don't let * further traces execute. * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly * by the command being traced, not because of * an internal trace. | < | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags. * TCL_TRACE_EXEC_IN_PROGRESS - The callback function on this trace is * currently executing. Therefore we don't let * further traces execute. * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly * by the command being traced, not because of * an internal trace. * The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces. */ #define TCL_TRACE_ENTER_DURING_EXEC 4 #define TCL_TRACE_LEAVE_DURING_EXEC 8 #define TCL_TRACE_ANY_EXEC 15 #define TCL_TRACE_EXEC_IN_PROGRESS 0x10 #define TCL_TRACE_EXEC_DIRECT 0x20 |
︙ | ︙ | |||
2640 2641 2642 2643 2644 2645 2646 | copiedName = 1; } break; } } } | < < < < < < < | 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 | copiedName = 1; } break; } } } /* * Invoke traces on the array containing the variable, if relevant. */ result = NULL; active.nextPtr = iPtr->activeVarTracePtr; iPtr->activeVarTracePtr = &active; |
︙ | ︙ | |||
2669 2670 2671 2672 2673 2674 2675 | if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve(tracePtr); if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); } | < < < | 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 | if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve(tracePtr); if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); } result = tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { /* * Ignore errors in unset traces. */ |
︙ | ︙ | |||
2713 2714 2715 2716 2717 2718 2719 | if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve(tracePtr); if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); } | < < < | 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 | if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve(tracePtr); if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); } result = tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { /* * Ignore errors in unset traces. */ |
︙ | ︙ |
Changes to generic/tclUtf.c.
︙ | ︙ | |||
784 785 786 787 788 789 790 | size_t len; int fullchar; Tcl_UniChar find = 0; while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; | | | 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 | size_t len; int fullchar; Tcl_UniChar find = 0; while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; #if TCL_UTF_MAX <= 3 if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &find); fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; } #endif if (fullchar == ch) { return src; |
︙ | ︙ | |||
833 834 835 836 837 838 839 | Tcl_UniChar find = 0; const char *last; last = NULL; while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; | | | 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 | Tcl_UniChar find = 0; const char *last; last = NULL; while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; #if TCL_UTF_MAX <= 3 if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &find); fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; } #endif if (fullchar == ch) { last = src; |
︙ | ︙ | |||
876 877 878 879 880 881 882 | const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { Tcl_UniChar ch = 0; size_t len = TclUtfToUniChar(src, &ch); | | | 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 | const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { Tcl_UniChar ch = 0; size_t len = TclUtfToUniChar(src, &ch); #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); } #endif return src + len; } |
︙ | ︙ | |||
958 959 960 961 962 963 964 | int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; | | | | | | 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 | int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; #if TCL_UTF_MAX <= 3 size_t len = 0; #endif src += TclUtfToUniChar(src, &ch); while (index--) { #if TCL_UTF_MAX <= 3 src += (len = TclUtfToUniChar(src, &ch)); #else src += TclUtfToUniChar(src, &ch); #endif } fullchar = ch; #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); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif return fullchar; } /* *--------------------------------------------------------------------------- * * Tcl_UtfAtIndex -- * * Returns a pointer to the specified character (not byte) position in * 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. * * Results: * As above. * * Side effects: |
︙ | ︙ | |||
1018 1019 1020 1021 1022 1023 1024 | while (index--) { #if TCL_UTF_MAX <= 4 src += (len = TclUtfToUniChar(src, &ch)); #else src += TclUtfToUniChar(src, &ch); #endif } | | | 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 | while (index--) { #if TCL_UTF_MAX <= 4 src += (len = TclUtfToUniChar(src, &ch)); #else src += TclUtfToUniChar(src, &ch); #endif } #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { /* Index points at character following high Surrogate */ src += TclUtfToUniChar(src, &ch); } #endif } return src; |
︙ | ︙ | |||
1115 1116 1117 1118 1119 1120 1121 | * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUniChar(src, &ch); upChar = ch; | | | 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 | * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUniChar(src, &ch); upChar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ upChar = (((upChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif upChar = Tcl_UniCharToUpper(upChar); |
︙ | ︙ | |||
1177 1178 1179 1180 1181 1182 1183 | * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUniChar(src, &ch); lowChar = ch; | | | 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 | * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUniChar(src, &ch); lowChar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif lowChar = Tcl_UniCharToLower(lowChar); |
︙ | ︙ | |||
1242 1243 1244 1245 1246 1247 1248 | */ src = dst = str; if (*src) { len = TclUtfToUniChar(src, &ch); titleChar = ch; | | | | 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 | */ src = dst = str; if (*src) { len = TclUtfToUniChar(src, &ch); titleChar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ titleChar = (((titleChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif titleChar = Tcl_UniCharToTitle(titleChar); if ((len < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) { memmove(dst, src, len); dst += len; } else { dst += Tcl_UniCharToUtf(titleChar, dst); } src += len; } while (*src) { len = TclUtfToUniChar(src, &ch); lowChar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif /* Special exception for Georgian Asomtavruli chars, no titlecase. */ |
︙ | ︙ | |||
1374 1375 1376 1377 1378 1379 1380 | * only when both strings are of at least n chars long (no need for \0 * check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { | | | 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 | * only when both strings are of at least n chars long (no need for \0 * check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; |
︙ | ︙ | |||
1425 1426 1427 1428 1429 1430 1431 | * n must be interpreted as chars, not bytes. * This should be called only when both strings are of * at least n chars long (no need for \0 check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { | | | 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 | * n must be interpreted as chars, not bytes. * This should be called only when both strings are of * at least n chars long (no need for \0 check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; |
︙ | ︙ | |||
1474 1475 1476 1477 1478 1479 1480 | { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { | | | 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 | { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; |
︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 | { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { | | | 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 | { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; |
︙ | ︙ | |||
1644 1645 1646 1647 1648 1649 1650 | } return ch & 0x1FFFFF; } /* *---------------------------------------------------------------------- * | | | | | | 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 | } return ch & 0x1FFFFF; } /* *---------------------------------------------------------------------- * * TclUniCharLen -- * * Find the length of a UniChar string. The str input must be null * terminated. * * Results: * Returns the length of str in UniChars (not bytes). * * Side effects: * None. * *---------------------------------------------------------------------- */ size_t TclUniCharLen( const Tcl_UniChar *uniStr) /* Unicode string to find length of. */ { size_t len = 0; while (*uniStr != '\0') { len++; uniStr++; } return len; } /* *---------------------------------------------------------------------- * * 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. * * Results: * Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct. * * Side effects: * None. * *---------------------------------------------------------------------- */ int 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. */ { #ifdef WORDS_BIGENDIAN /* * We are definitely on a big-endian machine; memcmp() is safe |
︙ | ︙ | |||
1718 1719 1720 1721 1722 1723 1724 | return 0; #endif /* WORDS_BIGENDIAN */ } /* *---------------------------------------------------------------------- * | | | | 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 | return 0; #endif /* WORDS_BIGENDIAN */ } /* *---------------------------------------------------------------------- * * 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 * unichars long. * * Results: * Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct. * * Side effects: * None. * *---------------------------------------------------------------------- */ int 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. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); |
︙ | ︙ | |||
2064 2065 2066 2067 2068 2069 2070 | } return ((WORD_BITS >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * | | | | 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 | } return ((WORD_BITS >> GetCategory(ch)) & 1); } /* *---------------------------------------------------------------------- * * TclUniCharCaseMatch -- * * See if a particular Unicode string matches a particular pattern. * Allows case insensitivity. This is the Unicode equivalent of the char* * Tcl_StringCaseMatch. The UniChar strings must be NULL-terminated. * This has no provision for counted UniChar strings, thus should not be * used where NULLs are expected in the UniChar string. Use * TclUniCharMatch where possible. * * Results: * The return value is 1 if string matches pattern, and 0 otherwise. The * matching operation permits the following special characters in the * pattern: *?\[] (see the manual entry for details on what these mean). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclUniCharCaseMatch( const Tcl_UniChar *uniStr, /* Unicode String. */ const Tcl_UniChar *uniPattern, /* Pattern, which may contain special * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { Tcl_UniChar ch1 = 0, p; |
︙ | ︙ | |||
2152 2153 2154 2155 2156 2157 2158 | } } else { while (*uniStr && (p != *uniStr)) { uniStr++; } } } | | | 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 | } } else { while (*uniStr && (p != *uniStr)) { uniStr++; } } } if (TclUniCharCaseMatch(uniStr, uniPattern, nocase)) { return 1; } if (*uniStr == 0) { return 0; } uniStr++; } |
︙ | ︙ | |||
2258 2259 2260 2261 2262 2263 2264 | /* *---------------------------------------------------------------------- * * TclUniCharMatch -- * * See if a particular Unicode string matches a particular pattern. * Allows case insensitivity. This is the Unicode equivalent of the char* | | | 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 | /* *---------------------------------------------------------------------- * * TclUniCharMatch -- * * 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 TclUniCharCaseMatch uses counted * Strings, so embedded NULLs are allowed. * * Results: * The return value is 1 if string matches pattern, and 0 otherwise. The * matching operation permits the following special characters in the * pattern: *?\[] (see the manual entry for details on what these mean). * |
︙ | ︙ |
Changes to tests/cmdIL.test.
︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 24 25 26 27 28 | ::tcltest::loadTestedCommands 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]] test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort } -result {wrong # args: should be "lsort ?-option value ...? list"} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort -foo {1 3 2 5} } -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique} | > | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | ::tcltest::loadTestedCommands 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 } -result {wrong # args: should be "lsort ?-option value ...? list"} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort -foo {1 3 2 5} } -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique} |
︙ | ︙ | |||
515 516 517 518 519 520 521 522 523 524 525 526 527 528 | test_lsort 0 } -result 0 -cleanup { rename test_lsort "" } 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}} # Compiled version test cmdIL-6.1 {lassign command syntax} -returnCodes error -body { apply {{} { lassign }} } -result {wrong # args: should be "lassign list ?varName ...?"} test cmdIL-6.2 {lassign command syntax} { apply {{} { lassign x }} | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 | test_lsort 0 } -result 0 -cleanup { rename test_lsort "" } 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 { apply {{} { lassign }} } -result {wrong # args: should be "lassign list ?varName ...?"} test cmdIL-6.2 {lassign command syntax} { apply {{} { lassign x }} |
︙ | ︙ |
Changes to tests/oo.test.
︙ | ︙ | |||
107 108 109 110 111 112 113 | } leaktest {[foo new] destroy} } -cleanup { foo destroy } -result 0 test oo-0.9 {various types of presence of the TclOO package} { list [lsearch -nocase -all -inline [package names] tcloo] \ | | | | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | } leaktest {[foo new] destroy} } -cleanup { foo destroy } -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] [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 {} lappend result [oo::object create foo] lappend result [oo::objdefine foo { method bar args { global result |
︙ | ︙ |
Changes to tests/stringObj.test.
︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 | ::tcltest::loadTestedCommands 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]] test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] set result [expr {$first != -1}] } {1} | > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | ::tcltest::loadTestedCommands 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 tip389 [expr {[string length \U010000] == 2}] test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] set result [expr {$first != -1}] } {1} |
︙ | ︙ | |||
460 461 462 463 464 465 466 | teststringobj set 1 foo teststringobj appendself 1 2 } fooo test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 3 } foo | | | | | | 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 | teststringobj set 1 foo teststringobj appendself 1 2 } fooo 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 tip389} { teststringobj set 1 foo teststringobj appendself2 1 0 } foofoo test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389} { teststringobj set 1 foo teststringobj appendself2 1 1 } foooo test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389} { teststringobj set 1 foo teststringobj appendself2 1 2 } fooo test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389} { teststringobj set 1 foo teststringobj appendself2 1 3 } foo if {[testConstraint testobj]} { testobj freeallvars } |
︙ | ︙ |
Changes to win/rules.vc.
︙ | ︙ | |||
680 681 682 683 684 685 686 | # USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation. # 0 -> Use the non-thread allocator. # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # 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) | | | 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 | # USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation. # 0 -> Use the non-thread allocator. # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # 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=4 - forces a build allowing 4-byte UTF-8 sequences internally. # Further, LINKERFLAGS are modified based on above. # Default values for all the above STATIC_BUILD = 0 TCL_THREADS = 1 DEBUG = 0 SYMBOLS = 0 |
︙ | ︙ | |||
750 751 752 753 754 755 756 | USE_THREAD_ALLOC= 0 !else TCL_THREADS = 1 USE_THREAD_ALLOC= 1 !endif !if [nmakehlp -f $(OPTS) "utfmax"] | | | | 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 | USE_THREAD_ALLOC= 0 !else TCL_THREADS = 1 USE_THREAD_ALLOC= 1 !endif !if [nmakehlp -f $(OPTS) "utfmax"] !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 # the "pdbs" option controls SYMBOLS. That's historical. !if [nmakehlp -f $(OPTS) "symbols"] !message *** Doing symbols DEBUG = 1 |
︙ | ︙ | |||
1349 1350 1351 1352 1353 1354 1355 | !if "$(MACHINE)" == "AMD64" OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 !endif | | | | 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 | !if "$(MACHINE)" == "AMD64" OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 !endif !if "$(TCL_UTF_MAX)" == "4" OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=4 !endif # _ATL_XP_TARGETING - Newer SDK's need this to build for XP COMPILERFLAGS = /D_ATL_XP_TARGETING # Like the TEA system only set this non empty for non-Tk extensions # Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME |
︙ | ︙ |