Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Merge trunk |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | tip-497 |
Files: | files | file ages | folders |
SHA3-256: |
cad1873c5d286c7ecd72f5f9395f29ea |
User & Date: | jan.nijtmans 2020-02-13 22:24:07.867 |
Context
2020-02-28
| ||
12:58 | Implement TIP #497: Full support for Unicode planes 1-16. check-in: f39bca856e user: jan.nijtmans tags: trunk | |
2020-02-13
| ||
22:24 | Merge trunk Closed-Leaf check-in: cad1873c5d user: jan.nijtmans tags: tip-497 | |
2020-02-12
| ||
13:19 | Merge 8.7 check-in: 7deb4251a7 user: jan.nijtmans tags: trunk | |
2020-01-24
| ||
11:00 | Merge trunk check-in: 4db2ba7da0 user: jan.nijtmans tags: tip-497 | |
Changes
Changes to .travis.yml.
1 2 3 4 5 6 7 8 | sudo: false language: c matrix: include: # Testing on Linux with various compilers - name: "Linux/GCC/Shared" os: linux | | | | | | | | | < < < < < < < < < < < < | | | | 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 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | sudo: false language: c matrix: include: # Testing on Linux with various compilers - name: "Linux/GCC/Shared" os: linux dist: bionic compiler: gcc env: - BUILD_DIR=unix - name: "Linux/GCC/Shared: UTF_MAX=3" os: linux dist: bionic compiler: gcc env: - BUILD_DIR=unix - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3" - name: "Linux/GCC/Shared: NO_DEPRECATED" os: linux dist: bionic compiler: gcc env: - BUILD_DIR=unix - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" - name: "Linux/GCC/Static" os: linux dist: bionic compiler: gcc env: - CFGOPT="--disable-shared" - BUILD_DIR=unix - name: "Linux/GCC/Debug" os: linux dist: bionic compiler: gcc env: - BUILD_DIR=unix - CFGOPT="--enable-symbols" # Older versions of GCC... - name: "Linux/GCC 7/Shared" os: linux dist: bionic compiler: gcc-7 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-7 env: - BUILD_DIR=unix - name: "Linux/GCC 6/Shared" os: linux dist: bionic compiler: gcc-6 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-6 env: - BUILD_DIR=unix - name: "Linux/GCC 5/Shared" os: linux dist: bionic compiler: gcc-5 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-5 env: - BUILD_DIR=unix # Clang - name: "Linux/Clang/Shared" os: linux dist: bionic compiler: clang env: - BUILD_DIR=unix - name: "Linux/Clang/Static" os: linux dist: bionic compiler: clang env: - CFGOPT="--disable-shared" - BUILD_DIR=unix - name: "Linux/Clang/Debug" os: linux dist: bionic compiler: clang env: - BUILD_DIR=unix - CFGOPT="--enable-symbols" # Testing on Mac, various styles - name: "macOS/Xcode 11.3/Shared/Unix-like" os: osx |
︙ | ︙ | |||
124 125 126 127 128 129 130 131 132 133 134 135 136 137 | - make all # The styles=develop avoids some weird problems on OSX - make test styles=develop addons: homebrew: packages: - libtommath - name: "macOS/Xcode 10/Shared" os: osx osx_image: xcode10.3 env: - BUILD_DIR=macosx install: [] script: *mactest | > > > > > > > | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | - make all # The styles=develop avoids some weird problems on OSX - make test styles=develop addons: homebrew: packages: - libtommath - name: "macOS/Xcode 11/Shared" os: osx osx_image: xcode11 env: - BUILD_DIR=macosx install: [] script: *mactest - name: "macOS/Xcode 10/Shared" os: osx osx_image: xcode10.3 env: - BUILD_DIR=macosx install: [] script: *mactest |
︙ | ︙ | |||
161 162 163 164 165 166 167 | homebrew: packages: - libtommath # Test with mingw-w64 cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows/GCC/Shared/no test" os: linux | | | | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | homebrew: packages: - libtommath # Test with mingw-w64 cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows/GCC/Shared/no test" os: linux dist: bionic compiler: x86_64-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-x86-64 - gcc-mingw-w64-x86-64 - gcc-mingw-w64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" script: &crosstest - make all tcltest # Include a high visibility marker that tests are skipped outright - > echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" # Test with mingw-w64 (32 bit) cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows-32/GCC/Shared/no test" os: linux dist: bionic compiler: i686-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-i686 - gcc-mingw-w64-i686 |
︙ | ︙ | |||
208 209 210 211 212 213 214 | - BUILD_DIR=win - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" before_install: &vcpreinst - PATH="$PATH:$VCDIR" - cd ${BUILD_DIR} install: [] script: | | | | | | | | | | | | | | | | | | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 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 | - BUILD_DIR=win - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" 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: NO_DEPRECATED" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=nodep' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test - name: "Windows/MSVC/Static" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test - name: "Windows/MSVC/Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test # Test on Windows with MSVC native (32-bit) - name: "Windows/MSVC-x86/Shared" os: windows 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: NO_DEPRECATED" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test - name: "Windows/MSVC-x86/Static" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test - name: "Windows/MSVC-x86/Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test # Test on Windows with GCC native - name: "Windows/GCC/Shared" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit" |
︙ | ︙ |
Changes to doc/SetResult.3.
1 2 3 4 5 6 7 8 9 10 11 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-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 Tcl_SetResult 3 8.7 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 19 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-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 Tcl_SetResult 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult \- manipulate Tcl result .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp \fBTcl_SetObjResult\fR(\fIinterp, objPtr\fR) .sp Tcl_Obj * |
︙ | ︙ | |||
27 28 29 30 31 32 33 | \fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR) .sp \fBTcl_ResetResult\fR(\fIinterp\fR) .sp \fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR) .sp \fBTcl_AppendElement\fR(\fIinterp, element\fR) | < < | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | \fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR) .sp \fBTcl_ResetResult\fR(\fIinterp\fR) .sp \fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR) .sp \fBTcl_AppendElement\fR(\fIinterp, element\fR) .SH ARGUMENTS .AS Tcl_FreeProc sourceInterp out .AP Tcl_Interp *interp out Interpreter whose result is to be modified or read. .AP Tcl_Obj *objPtr in Tcl value to become result for \fIinterp\fR. .AP char *result in |
︙ | ︙ | |||
173 174 175 176 177 178 179 | However if the new list element is the first in a list or sub-list (i.e. \fIinterp\fR's current result is empty, or consists of the single character .QW { , or ends in the characters .QW " {" ) then no space is added. | < < < < < < < < | 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | However if the new list element is the first in a list or sub-list (i.e. \fIinterp\fR's current result is empty, or consists of the single character .QW { , or ends in the characters .QW " {" ) then no space is added. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP \fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how the Tcl system is to manage the storage for the \fIresult\fR argument. If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called at a time when \fIinterp\fR holds a string result, they do whatever is necessary to dispose of the old string result |
︙ | ︙ |
Changes to generic/tcl.decls.
︙ | ︙ | |||
536 537 538 539 540 541 542 | declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 { int Tcl_Flush(Tcl_Channel chan) } | > | | < > | 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 | declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 { int Tcl_Flush(Tcl_Channel chan) } # Removed in 9.0, TIP 559 #declare 147 { # void Tcl_FreeResult(Tcl_Interp *interp) #} declare 148 { int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr) } declare 149 { int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, |
︙ | ︙ | |||
2063 2064 2065 2066 2067 2068 2069 | declare 554 { Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) } # TIP#237 (arbitrary-precision integers) kbk declare 555 { | | | | | | | 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 | declare 554 { Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) } # TIP#237 (arbitrary-precision integers) kbk declare 555 { Tcl_Obj *Tcl_NewBignumObj(void *value) } declare 556 { Tcl_Obj *Tcl_DbNewBignumObj(void *value, const char *file, int line) } declare 557 { void Tcl_SetBignumObj(Tcl_Obj *obj, void *value) } declare 558 { int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value) } declare 559 { int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value) } # TIP #208 ('chan' command) jeffh declare 560 { int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length) } declare 561 { |
︙ | ︙ | |||
2104 2105 2106 2107 2108 2109 2110 | declare 565 { void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg) } # TIP #237 (additional conversion functions for bignum support) kbk/dgp declare 566 { int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, | | | 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 | declare 565 { void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg) } # TIP #237 (additional conversion functions for bignum support) kbk/dgp declare 566 { int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, void *toInit) } # TIP#181 (namespace unknown command) dgp for Neil Madden declare 567 { Tcl_Obj *Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr) } |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
1989 1990 1991 1992 1993 1994 1995 1996 1997 | * Structure containing information about a limit handler to be called when a * command- or time-limit is exceeded by an interpreter. */ typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData); /* *---------------------------------------------------------------------------- | > > > > | > > > > > | 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 | * Structure containing information about a limit handler to be called when a * command- or time-limit is exceeded by an interpreter. */ typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData); #if 0 /* *---------------------------------------------------------------------------- * We would like to provide an anonymous structure "mp_int" here, which is * compatible with libtommath's "mp_int", but without duplicating anything * from <tommath.h> or including <tommath.h> here. But the libtommath project * didn't honor our request. See: <https://github.com/libtom/libtommath/pull/473> * * That's why this part is commented out, and we are using (void *) in * various API's in stead of the more correct (mp_int *). */ #ifndef MP_INT_DECLARED #define MP_INT_DECLARED typedef struct mp_int mp_int; #endif #endif /* *---------------------------------------------------------------------------- * Definitions needed for Tcl_ParseArgvObj routines. * Based on tkArgv.c. * Modifications from the original are copyright (c) Sam Bromley 2006 |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
430 431 432 433 434 435 436 | EXTERN void Tcl_Finalize(void); /* Slot 144 is reserved */ /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); | | < | 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 | EXTERN void Tcl_Finalize(void); /* Slot 144 is reserved */ /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); /* Slot 147 is reserved */ /* 148 */ EXTERN int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 149 */ |
︙ | ︙ | |||
1487 1488 1489 1490 1491 1492 1493 | EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); /* 555 */ | | | | | | | | 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 | EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); /* 555 */ EXTERN Tcl_Obj * Tcl_NewBignumObj(void *value); /* 556 */ EXTERN Tcl_Obj * Tcl_DbNewBignumObj(void *value, const char *file, int line); /* 557 */ EXTERN void Tcl_SetBignumObj(Tcl_Obj *obj, void *value); /* 558 */ EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 560 */ EXTERN int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length); /* 561 */ EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr); /* 562 */ EXTERN void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg); /* 563 */ EXTERN void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj **msg); /* 564 */ EXTERN void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg); /* 565 */ EXTERN void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg); /* 566 */ EXTERN int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, void *toInit); /* 567 */ EXTERN Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 568 */ EXTERN int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 569 */ |
︙ | ︙ | |||
1928 1929 1930 1931 1932 1933 1934 | int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */ int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ | | | 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 | int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */ int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*reserved147)(void); int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, void **handlePtr); /* 153 */ void * (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ |
︙ | ︙ | |||
2344 2345 2346 2347 2348 2349 2350 | int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */ int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, void *clientData); /* 552 */ void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ | | | | | | | | 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 | int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */ int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, void *clientData); /* 552 */ void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ Tcl_Obj * (*tcl_NewBignumObj) (void *value); /* 555 */ Tcl_Obj * (*tcl_DbNewBignumObj) (void *value, const char *file, int line); /* 556 */ void (*tcl_SetBignumObj) (Tcl_Obj *obj, void *value); /* 557 */ int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 558 */ int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */ Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */ void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */ void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */ void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */ void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */ int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, void *toInit); /* 566 */ Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */ int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */ int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */ Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */ int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */ const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */ int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */ |
︙ | ︙ | |||
2741 2742 2743 2744 2745 2746 2747 | #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ /* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ | < | | 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 | #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ /* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ /* Slot 147 is reserved */ #define Tcl_GetAlias \ (tclStubsPtr->tcl_GetAlias) /* 148 */ #define Tcl_GetAliasObj \ (tclStubsPtr->tcl_GetAliasObj) /* 149 */ #define Tcl_GetAssocData \ (tclStubsPtr->tcl_GetAssocData) /* 150 */ #define Tcl_GetChannel \ |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
200 201 202 203 204 205 206 | static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush); static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr); static Tcl_Encoding GetBinaryEncoding(); static void FreeBinaryEncoding(ClientData clientData); static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp); static int GetInput(Channel *chanPtr); | < < | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush); static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr); static Tcl_Encoding GetBinaryEncoding(); static void FreeBinaryEncoding(ClientData clientData); static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp); static int GetInput(Channel *chanPtr); static void PeekAhead(Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr); static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft); static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft, int *factorPtr); static void RecycleBuffer(ChannelState *statePtr, |
︙ | ︙ | |||
488 489 490 491 492 493 494 | int *errnoPtr) { /* * Note that we prefer the wideSeekProc if that field is available in the * type and non-NULL. */ | < | | | | 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 | int *errnoPtr) { /* * Note that we prefer the wideSeekProc if that field is available in the * type and non-NULL. */ if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) { return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData, offset, mode, errnoPtr); } if (offset<LONG_MIN || offset>LONG_MAX) { *errnoPtr = EOVERFLOW; return -1; } return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, offset, mode, errnoPtr); } static inline void ChanThreadAction( Channel *chanPtr, int action) |
︙ | ︙ | |||
4212 4213 4214 4215 4216 4217 4218 | static void WillWrite( Channel *chanPtr) { int inputBuffered; | | | 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 | static void WillWrite( Channel *chanPtr) { int inputBuffered; if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ int ignore; DiscardInputQueued(chanPtr->state, 0); ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore); } } |
︙ | ︙ | |||
4234 4235 4236 4237 4238 4239 4240 | * Prevent read attempts on a closed channel. */ DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); return -1; } | | | 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 | * Prevent read attempts on a closed channel. */ DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); return -1; } if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { /* * CAVEAT - The assumption here is that FlushChannel() will push out * the bytes of any writes that are in progress. Since this is a * seekable channel, we assume it is not one that can block and force * bg flushing. Channels we know that can do that - sockets, pipes - * are not seekable. If the assumption is wrong, more drastic measures |
︙ | ︙ | |||
6997 6998 6999 7000 7001 7002 7003 | chanPtr = statePtr->topChanPtr; /* * Disallow seek on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ | | | 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 7007 7008 | chanPtr = statePtr->topChanPtr; /* * Disallow seek on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) { Tcl_SetErrno(EINVAL); return -1; } /* * Compute how much input and output is buffered. If both input and output * is buffered, cannot compute the current position. |
︙ | ︙ | |||
7161 7162 7163 7164 7165 7166 7167 | chanPtr = statePtr->topChanPtr; /* * Disallow tell on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ | | | 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 | chanPtr = statePtr->topChanPtr; /* * Disallow tell on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) { Tcl_SetErrno(EINVAL); return -1; } /* * Compute how much input and output is buffered. If both input and output * is buffered, cannot compute the current position. |
︙ | ︙ | |||
10484 10485 10486 10487 10488 10489 10490 | */ Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | < | < < < < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < | 10481 10482 10483 10484 10485 10486 10487 10488 10489 10490 10491 10492 10493 10494 10495 10496 10497 10498 10499 10500 10501 10502 10503 | */ Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2) || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) { /* * In <v2 channel versions, the version field is occupied by the * Tcl_DriverBlockModeProc */ return TCL_CHANNEL_VERSION_1; } return chanTypePtr->version; } /* *---------------------------------------------------------------------- * * Tcl_ChannelBlockModeProc -- * |
︙ | ︙ | |||
10549 10550 10551 10552 10553 10554 10555 | *---------------------------------------------------------------------- */ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | < < < | | | > | | > | 10512 10513 10514 10515 10516 10517 10518 10519 10520 10521 10522 10523 10524 10525 10526 10527 10528 10529 10530 10531 10532 10533 | *---------------------------------------------------------------------- */ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { /* * The v1 structure had the blockModeProc in a different place. */ return (Tcl_DriverBlockModeProc *) chanTypePtr->version; } return chanTypePtr->blockModeProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelCloseProc -- * |
︙ | ︙ | |||
10797 10798 10799 10800 10801 10802 10803 | */ Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 10759 10760 10761 10762 10763 10764 10765 10766 10767 10768 10769 10770 10771 10772 10773 10774 10775 10776 | */ Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { return NULL; } return chanTypePtr->flushProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelHandlerProc -- * |
︙ | ︙ | |||
10824 10825 10826 10827 10828 10829 10830 | */ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 10786 10787 10788 10789 10790 10791 10792 10793 10794 10795 10796 10797 10798 10799 10800 10801 10802 10803 | */ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { return NULL; } return chanTypePtr->handlerProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelWideSeekProc -- * |
︙ | ︙ | |||
10851 10852 10853 10854 10855 10856 10857 | */ Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 10813 10814 10815 10816 10817 10818 10819 10820 10821 10822 10823 10824 10825 10826 10827 10828 10829 10830 | */ Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) { return NULL; } return chanTypePtr->wideSeekProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelThreadActionProc -- * |
︙ | ︙ | |||
10879 10880 10881 10882 10883 10884 10885 | */ Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 10841 10842 10843 10844 10845 10846 10847 10848 10849 10850 10851 10852 10853 10854 10855 10856 10857 10858 | */ Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) { return NULL; } return chanTypePtr->threadActionProc; } /* *---------------------------------------------------------------------- * * Tcl_SetChannelErrorInterp -- * |
︙ | ︙ | |||
11194 11195 11196 11197 11198 11199 11200 | */ Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 11156 11157 11158 11159 11160 11161 11162 11163 11164 11165 11166 11167 11168 11169 11170 11171 11172 11173 | */ Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_5) { return NULL; } return chanTypePtr->truncateProc; } /* *---------------------------------------------------------------------- * * DupChannelIntRep -- * |
︙ | ︙ |
Changes to generic/tclIOCmd.c.
︙ | ︙ | |||
680 681 682 683 684 685 686 | " or already closed", dirOptions[index])); return TCL_ERROR; } /* * Special handling is needed if and only if the channel mode supports * more than the direction to close. Because if the close the last | | | 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 | " or already closed", dirOptions[index])); return TCL_ERROR; } /* * Special handling is needed if and only if the channel mode supports * more than the direction to close. Because if the close the last * direction supported we can and will go through the regular * process. */ if ((Tcl_GetChannelMode(chan) & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) { return Tcl_CloseEx(interp, chan, dir); } |
︙ | ︙ |
Changes to generic/tclIORTrans.c.
︙ | ︙ | |||
23 24 25 26 27 28 29 | #ifndef EINVAL #define EINVAL 9 #endif #ifndef EOK #define EOK 0 #endif | < < < < | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | #ifndef EINVAL #define EINVAL 9 #endif #ifndef EOK #define EOK 0 #endif /* * Signatures of all functions used in the C layer of the reflection. */ static int ReflectClose(ClientData clientData, Tcl_Interp *interp); static int ReflectInput(ClientData clientData, char *buf, |
︙ | ︙ | |||
1382 1383 1384 1385 1386 1387 1388 | /* * Now seek to the new position in the channel as requested by the * caller. Note that we prefer the wideSeekProc if that is available and * non-NULL... */ | < | | | | 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 | /* * Now seek to the new position in the channel as requested by the * caller. Note that we prefer the wideSeekProc if that is available and * non-NULL... */ if (Tcl_ChannelWideSeekProc(parent->typePtr) != NULL) { curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset, seekMode, errorCodePtr); } else if (offset < LONG_MIN || offset > LONG_MAX) { *errorCodePtr = EOVERFLOW; curPos = -1; } else { curPos = Tcl_ChannelSeekProc(parent->typePtr)( parent->instanceData, offset, seekMode, errorCodePtr); } if (curPos == -1) { Tcl_SetErrno(*errorCodePtr); } |
︙ | ︙ | |||
3385 3386 3387 3388 3389 3390 3391 | return 0; } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_RestoreInterpState(rtPtr->interp, sr); return 1; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 | return 0; } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_RestoreInterpState(rtPtr->interp, sr); return 1; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2841 2842 2843 2844 2845 2846 2847 | MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr); | | | | 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 | MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr); MODULE_SCOPE double TclBignumToDouble(const void *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, size_t strLen, const unsigned char *pattern, size_t ptnLen, int flags); MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index); MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); |
︙ | ︙ | |||
2926 2927 2928 2929 2930 2931 2932 | MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclInitThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); | | | 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 | MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclInitThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const void *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, const char *attributeName, int *indexPtr); MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, void *clientData, |
︙ | ︙ | |||
3117 3118 3119 3120 3121 3122 3123 | size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); MODULE_SCOPE size_t TclScanElement(const char *string, size_t length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, | | | 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 | size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); MODULE_SCOPE size_t TclScanElement(const char *string, size_t length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, void *bignumValue); MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); |
︙ | ︙ |
Changes to generic/tclLink.c.
︙ | ︙ | |||
160 161 162 163 164 165 166 | Tcl_Obj *objPtr; Link *linkPtr; Namespace *dummy; const char *name; int code; linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, | | | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | Tcl_Obj *objPtr; Link *linkPtr; Namespace *dummy; const char *name; int code; linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, NULL); if (linkPtr != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "variable '%s' is already linked", varName)); return TCL_ERROR; } linkPtr = Tcl_Alloc(sizeof(Link)); |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
3043 3044 3045 3046 3047 3048 3049 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewBignumObj Tcl_Obj * Tcl_NewBignumObj( | | | | 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewBignumObj Tcl_Obj * Tcl_NewBignumObj( void *bignumValue) { return Tcl_DbNewBignumObj(bignumValue, "unknown", 0); } #else Tcl_Obj * Tcl_NewBignumObj( void *bignumValue) { Tcl_Obj *objPtr; TclNewObj(objPtr); Tcl_SetBignumObj(objPtr, bignumValue); return objPtr; } |
︙ | ︙ | |||
3081 3082 3083 3084 3085 3086 3087 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBignumObj( | | | | 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBignumObj( void *bignumValue, const char *file, int line) { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); Tcl_SetBignumObj(objPtr, bignumValue); return objPtr; } #else Tcl_Obj * Tcl_DbNewBignumObj( void *bignumValue, const char *file, int line) { return Tcl_NewBignumObj(bignumValue); } #endif |
︙ | ︙ | |||
3206 3207 3208 3209 3210 3211 3212 | *---------------------------------------------------------------------- */ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ | | | | 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 | *---------------------------------------------------------------------- */ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 1, (mp_int *)bignumValue); } /* *---------------------------------------------------------------------- * * Tcl_TakeBignumFromObj -- * |
︙ | ︙ | |||
3241 3242 3243 3244 3245 3246 3247 | *---------------------------------------------------------------------- */ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ | | | | 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 | *---------------------------------------------------------------------- */ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 0, (mp_int *)bignumValue); } /* *---------------------------------------------------------------------- * * Tcl_SetBignumObj -- * |
︙ | ︙ | |||
3266 3267 3268 3269 3270 3271 3272 | * *---------------------------------------------------------------------- */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ | | > | 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 | * *---------------------------------------------------------------------- */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ void *big) /* Value to store */ { Tcl_WideUInt value = 0; size_t numBytes; Tcl_WideUInt scratch; unsigned char *bytes = (unsigned char *) &scratch; mp_int *bignumValue = (mp_int *) big; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj"); } if (mp_to_ubin(bignumValue, bytes, sizeof(Tcl_WideUInt), &numBytes) != MP_OKAY) { goto tooLargeForWide; } |
︙ | ︙ | |||
3319 3320 3321 3322 3323 3324 3325 | * *---------------------------------------------------------------------- */ void TclSetBignumIntRep( Tcl_Obj *objPtr, | | > | 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 | * *---------------------------------------------------------------------- */ void TclSetBignumIntRep( Tcl_Obj *objPtr, void *big) { mp_int *bignumValue = (mp_int *)big; objPtr->typePtr = &tclBignumType; PACK_BIGNUM(*bignumValue, objPtr); /* * Clear the mp_int value. * * Don't call mp_clear() because it would free the digit array we just |
︙ | ︙ |
Changes to generic/tclResult.c.
︙ | ︙ | |||
365 366 367 368 369 370 371 | bytes = TclGetStringFromObj(iPtr->objResultPtr, &length); if (TclNeedSpace(bytes, bytes + length)) { Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 365 366 367 368 369 370 371 372 373 374 375 376 377 378 | bytes = TclGetStringFromObj(iPtr->objResultPtr, &length); if (TclNeedSpace(bytes, bytes + length)) { Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); } /* *---------------------------------------------------------------------- * * Tcl_ResetResult -- * * This function resets both the interpreter's string and object results. |
︙ | ︙ |
Changes to generic/tclStrToD.c.
︙ | ︙ | |||
4620 4621 4622 4623 4624 4625 4626 | *---------------------------------------------------------------------- */ int Tcl_InitBignumFromDouble( Tcl_Interp *interp, /* For error message. */ double d, /* Number to convert. */ | | > | 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 | *---------------------------------------------------------------------- */ int Tcl_InitBignumFromDouble( Tcl_Interp *interp, /* For error message. */ double d, /* Number to convert. */ void *big) /* Place to store the result. */ { double fract; int expt; mp_err err; mp_int *b = (mp_int *)big; /* * Infinite values can't convert to bignum. */ if (TclIsInfinite(d)) { if (interp != NULL) { |
︙ | ︙ | |||
4680 4681 4682 4683 4684 4685 4686 | * too large to convert. * *---------------------------------------------------------------------- */ double TclBignumToDouble( | | > | 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 | * too large to convert. * *---------------------------------------------------------------------- */ double TclBignumToDouble( const void *big) /* Integer to convert. */ { mp_int b; int bits, shift, i, lsb; double r; mp_err err; const mp_int *a = (const mp_int *)big; /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. */ |
︙ | ︙ | |||
4801 4802 4803 4804 4805 4806 4807 | * Returns the floating point number. * *---------------------------------------------------------------------- */ double TclCeil( | | > | 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 | * Returns the floating point number. * *---------------------------------------------------------------------- */ double TclCeil( const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; mp_err err; const mp_int *a = (const mp_int *)big; err = mp_init(&b); if ((err == MP_OKAY) && mp_isneg(a)) { err = mp_neg(a, &b); r = -TclFloor(&b); } else { int bits = mp_count_bits(a); |
︙ | ︙ | |||
4866 4867 4868 4869 4870 4871 4872 | * Returns the floating point value. * *---------------------------------------------------------------------- */ double TclFloor( | | > | 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 | * Returns the floating point value. * *---------------------------------------------------------------------- */ double TclFloor( const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; mp_err err; const mp_int *a = (const mp_int *)big; err = mp_init(&b); if ((err == MP_OKAY) && mp_isneg(a)) { err = mp_neg(a, &b); r = -TclCeil(&b); } else { int bits = mp_count_bits(a); |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
896 897 898 899 900 901 902 | Tcl_ExprLongObj, /* 140 */ Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ 0, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ | | | 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 | Tcl_ExprLongObj, /* 140 */ Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ 0, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ 0, /* 147 */ Tcl_GetAlias, /* 148 */ Tcl_GetAliasObj, /* 149 */ Tcl_GetAssocData, /* 150 */ Tcl_GetChannel, /* 151 */ Tcl_GetChannelBufferSize, /* 152 */ Tcl_GetChannelHandle, /* 153 */ Tcl_GetChannelInstanceData, /* 154 */ |
︙ | ︙ |
Changes to generic/tclZipfs.c.
︙ | ︙ | |||
388 389 390 391 392 393 394 395 396 397 398 399 400 401 | Tcl_Interp *interp); static int ZipChannelGetFile(void *instanceData, int direction, void **handlePtr); static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); static int ZipChannelSeek(void *instanceData, long offset, int mode, int *errloc); static void ZipChannelWatchChannel(void *instanceData, int mask); static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); /* * Define the ZIP filesystem dispatch table. | > > | 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 | Tcl_Interp *interp); static int ZipChannelGetFile(void *instanceData, int direction, void **handlePtr); static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); static int ZipChannelSeek(void *instanceData, long offset, int mode, int *errloc); static Tcl_WideInt ZipChannelWideSeek(void *instanceData, Tcl_WideInt offset, int mode, int *errloc); static void ZipChannelWatchChannel(void *instanceData, int mask); static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); /* * Define the ZIP filesystem dispatch table. |
︙ | ︙ | |||
450 451 452 453 454 455 456 | NULL, /* Get options, NULL'able */ ZipChannelWatchChannel, /* Initialize notifier */ ZipChannelGetFile, /* Get OS handle from the channel */ NULL, /* 2nd version of close channel, NULL'able */ NULL, /* Set blocking mode for raw channel, NULL'able */ NULL, /* Function to flush channel, NULL'able */ NULL, /* Function to handle event, NULL'able */ | | | 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 | NULL, /* Get options, NULL'able */ ZipChannelWatchChannel, /* Initialize notifier */ ZipChannelGetFile, /* Get OS handle from the channel */ NULL, /* 2nd version of close channel, NULL'able */ NULL, /* Set blocking mode for raw channel, NULL'able */ NULL, /* Function to flush channel, NULL'able */ NULL, /* Function to handle event, NULL'able */ ZipChannelWideSeek, /* Wide seek function, NULL'able */ NULL, /* Thread action function, NULL'able */ NULL, /* Truncate function, NULL'able */ }; /* *------------------------------------------------------------------------- * |
︙ | ︙ | |||
1276 1277 1278 1279 1280 1281 1282 | ZipFSCloseArchive(interp, zf0); return TCL_ERROR; } Unlock(); *zf = *zf0; zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); | | | 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 | ZipFSCloseArchive(interp, zf0); return TCL_ERROR; } Unlock(); *zf = *zf0; zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); Tcl_CreateExitHandler(ZipfsExitHandler, zf); zf->mountPointLen = strlen(zf->mountPoint); zf->nameLength = strlen(zipname); zf->name = Tcl_Alloc(zf->nameLength + 1); memcpy(zf->name, zipname, zf->nameLength + 1); zf->entries = NULL; zf->topEnts = NULL; zf->numOpen = 0; |
︙ | ︙ | |||
1842 1843 1844 1845 1846 1847 1848 | } if (z->data) { Tcl_Free(z->data); } Tcl_Free(z); } ZipFSCloseArchive(interp, zf); | | | 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 | } if (z->data) { Tcl_Free(z->data); } Tcl_Free(z); } ZipFSCloseArchive(interp, zf); Tcl_DeleteExitHandler(ZipfsExitHandler, zf); Tcl_Free(zf); unmounted = 1; done: Unlock(); if (unmounted) { Tcl_FSMountsChanged(NULL); } |
︙ | ︙ | |||
3462 3463 3464 3465 3466 3467 3468 | *errloc = 0; return toWrite; } /* *------------------------------------------------------------------------- * | | | | | | | 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 | *errloc = 0; return toWrite; } /* *------------------------------------------------------------------------- * * ZipChannelSeek/ZipChannelWideSeek -- * * This function is called to position file pointer of channel. * * Results: * New file position or -1 on error with error number set. * * Side effects: * File pointer is repositioned according to offset and mode. * *------------------------------------------------------------------------- */ static Tcl_WideInt ZipChannelWideSeek( void *instanceData, Tcl_WideInt offset, int mode, int *errloc) { ZipChannel *info = (ZipChannel *) instanceData; size_t end; if (!info->isWriting && (info->isDirectory < 0)) { /* * Special case: when executable combined with ZIP archive file, seek * within front of ZIP, i.e. the executable itself. */ end = info->zipFilePtr->baseOffset; |
︙ | ︙ | |||
3515 3516 3517 3518 3519 3520 3521 | return -1; } if (offset < 0) { *errloc = EINVAL; return -1; } if (info->isWriting) { | | | | | > > > > > > > > > > | 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 | return -1; } if (offset < 0) { *errloc = EINVAL; return -1; } if (info->isWriting) { if ((size_t) offset > info->maxWrite) { *errloc = EINVAL; return -1; } if ((size_t) offset > info->numBytes) { info->numBytes = offset; } } else if ((size_t) offset > end) { *errloc = EINVAL; return -1; } info->numRead = (size_t) offset; return info->numRead; } static int ZipChannelSeek( void *instanceData, long offset, int mode, int *errloc) { return ZipChannelWideSeek(instanceData, offset, mode, errloc); } /* *------------------------------------------------------------------------- * * ZipChannelWatchChannel -- * * This function is called for event notifications on channel. Does |
︙ | ︙ |
Changes to generic/tclZlib.c.
︙ | ︙ | |||
200 201 202 203 204 205 206 | /* * Type of zlib-based compressing and decompressing channels. */ static const Tcl_ChannelType zlibChannelType = { "zlib", | | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 | /* * Type of zlib-based compressing and decompressing channels. */ static const Tcl_ChannelType zlibChannelType = { "zlib", TCL_CHANNEL_VERSION_5, ZlibTransformClose, ZlibTransformInput, ZlibTransformOutput, NULL, /* seekProc */ ZlibTransformSetOption, ZlibTransformGetOption, ZlibTransformWatch, |
︙ | ︙ |
Changes to library/tcltest/tcltest.tcl.
︙ | ︙ | |||
966 967 968 969 970 971 972 | variable testConstraints variable Option DebugPuts 3 "entering testConstraint $constraint $value" if {[llength [info level 0]] == 2} { return $testConstraints($constraint) } # Check for boolean values | | | 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 | variable testConstraints variable Option DebugPuts 3 "entering testConstraint $constraint $value" if {[llength [info level 0]] == 2} { return $testConstraints($constraint) } # Check for boolean values if {[catch {expr {$value && 1}} msg]} { return -code error $msg } if {[limitConstraints] && ($constraint ni $Option(-constraints))} { set value 0 } set testConstraints($constraint) $value } |
︙ | ︙ |
Changes to tests/cmdIL.test.
︙ | ︙ | |||
15 16 17 18 19 20 21 | ::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]] | | > | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | ::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]] source [file join [file dirname [info script]] internals.tcl] namespace import -force ::tcltest::internals::* 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} |
︙ | ︙ | |||
516 517 518 519 520 521 522 | 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}} | | | | | < | < < | < < < < < > > | | | | < | < < < < < < < < < < < | | 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 | 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 {testWithLimit} -body { # test it in child process (with limited address space) ca. 80MB extra memory # on x64 system it would be not enough to sort 4M items (the half 2M only), # warn and skip if no error (enough memory) or error by list creation: testWithLimit \ -warn-on-code 0 -warn-on-alloc-error 1 \ -addmem [expr {$tcl_platform(pointerSize)*4000000 + $tcl_platform(pointerSize)*3*2000000}] \ { # create list and get length (avoid too long output in interactive shells): llength [set l [lrepeat 4000000 ""]] # test OOM: llength [lsort $l] } # expecting error no memory by sort } -returnCodes 1 -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 }} |
︙ | ︙ |
Added tests/internals.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | # This file contains internal facilities for Tcl tests. # # Source this file in the related tests to include from tcl-tests: # # source [file join [file dirname [info script]] internals.tcl] # # Copyright (c) 2020 Sergey G. Brester (sebres). # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[namespace which -command ::tcltest::internals::scriptpath] eq ""} {namespace eval ::tcltest::internals { namespace path ::tcltest ::tcltest::ConstraintInitializer testWithLimit { expr {[testConstraint macOrUnix] && ![catch { exec prlimit --version }]} } # test-with-limit -- # # Usage: test-with-limit ?-addmem bytes? ?-maxmem bytes? command # Options: # -addmem - set additional memory limit (in bytes) as difference (extra memory needed to run a test) # -maxmem - set absolute maximum address space limit (in bytes) # proc testWithLimit args { set body [lindex $args end] array set in [lrange $args 0 end-1] # test in child process (with limits): set pipe {} if {[catch { # start new process: set pipe [open |[list [interpreter]] r+] set ppid [pid $pipe] # create prlimit args: set args {} # with limited address space: if {[info exists in(-addmem)] || [info exists in(-maxmem)]} { if {[info exists in(-addmem)]} { # as differnce to normal usage, so try to retrieve current memory usage: if {[catch { # using ps (vsz is in KB): incr in(-addmem) [expr {[lindex [exec ps -hq $ppid -o vsz] end] * 1024}] }]} { # ps failed, use default size 20MB: incr in(-addmem) 20000000 # + size of locale-archive (may be up to 100MB): incr in(-addmem) [expr { [file exists /usr/lib/locale/locale-archive] ? [file size /usr/lib/locale/locale-archive] : 0 }] } if {![info exists in(-maxmem)]} { set in(-maxmem) $in(-addmem) } set in(-maxmem) [expr { max($in(-addmem), $in(-maxmem)) }] } append args --as=$in(-maxmem) } # apply limits: exec prlimit -p $ppid {*}$args } msg opt]} { catch {close $pipe} tcltest::Warn "testWithLimit: error - [regsub {^\s*([^\n]*).*$} $msg {\1}]" tcltest::Skip testWithLimit } # execute body, close process and return: set ret [catch { chan configure $pipe -buffering line puts $pipe "puts \[$body\]" puts $pipe exit set result [read $pipe] close $pipe set pipe {} set result } result opt] if {$pipe ne ""} { catch { close $pipe } } if {$ret && [dict get $opt -errorcode] eq "BYPASS-SKIPPED-TEST"} { return {*}$opt $result } if { ( [info exists in(-warn-on-code)] && $ret in $in(-warn-on-code) ) || ( $ret && [info exists in(-warn-on-alloc-error)] && $in(-warn-on-alloc-error) && [regexp {\munable to (?:re)?alloc\M} $result] ) } { tcltest::Warn "testWithLimit: wrong limit, result: $result" tcltest::Skip testWithLimit } return {*}$opt $result } # export all routines starting with test namespace export test* # for script path & as mark for loaded proc scriptpath {} [list return [info script]] }}; # end of internals. |
Changes to unix/configure.
︙ | ︙ | |||
5309 5310 5311 5312 5313 5314 5315 | DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 | | | 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 | DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\[email protected]" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Cygwin version of gcc" >&5 $as_echo_n "checking for Cygwin version of gcc... " >&6; } if ${ac_cv_cygwin+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext |
︙ | ︙ | |||
6729 6730 6731 6732 6733 6734 6735 | if test "${enable_symbols+set}" = set; then : enableval=$enable_symbols; tcl_ok=$enableval else tcl_ok=no fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. | < | 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 | if test "${enable_symbols+set}" = set; then : enableval=$enable_symbols; tcl_ok=$enableval else tcl_ok=no fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' $as_echo "#define NDEBUG 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 |
︙ | ︙ |
Changes to unix/tcl.m4.
︙ | ︙ | |||
289 290 291 292 293 294 295 | if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi | < < < < | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # If the TCL_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TCL_LIB_SPEC will be set to the value # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TCL_BIN_DIR}/Makefile" ; then |
︙ | ︙ | |||
326 327 328 329 330 331 332 | TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi ;; esac fi | < < < < < < | 322 323 324 325 326 327 328 329 330 331 332 333 334 335 | TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi ;; esac fi AC_SUBST(TCL_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) |
︙ | ︙ | |||
372 373 374 375 376 377 378 | if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TK_BIN_DIR}/tkConfig.sh" else AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi | < < < < | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 | if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TK_BIN_DIR}/tkConfig.sh" else AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi # If the TK_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TK_LIB_SPEC will be set to the value # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC # instead of TK_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TK_BIN_DIR}/Makefile" ; then |
︙ | ︙ | |||
409 410 411 412 413 414 415 | TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" fi ;; esac fi | < < < < < < | 395 396 397 398 399 400 401 402 403 404 405 406 407 408 | TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" fi ;; esac fi AC_SUBST(TK_VERSION) AC_SUBST(TK_BIN_DIR) AC_SUBST(TK_SRC_DIR) AC_SUBST(TK_LIB_FILE) AC_SUBST(TK_LIB_FLAG) AC_SUBST(TK_LIB_SPEC) |
︙ | ︙ | |||
620 621 622 623 624 625 626 | # --enable-symbols # # Defines the following vars: # CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true # Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false | < < < | 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 | # --enable-symbols # # Defines the following vars: # CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true # Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, AC_HELP_STRING([--enable-symbols], [build with debugging symbols (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?]) AC_MSG_RESULT([no]) AC_DEFINE(TCL_CFG_OPTIMIZED, 1, [Is this an optimized build?]) else |
︙ | ︙ | |||
1105 1106 1107 1108 1109 1110 1111 | DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 | | | 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 | DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a" AC_CACHE_CHECK(for Cygwin version of gcc, ac_cv_cygwin, AC_TRY_COMPILE([ #ifdef __CYGWIN__ #error cygwin #endif |
︙ | ︙ |
Changes to unix/tclUnixSock.c.
︙ | ︙ | |||
683 684 685 686 687 688 689 | static int TcpClose2Proc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = instanceData; | | | < < < < < | < < < | < < | > | | | | < | 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 | static int TcpClose2Proc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = instanceData; int readError = 0; int writeError = 0; /* * Shutdown the OS socket handle. */ if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { return TcpCloseProc(instanceData, interp); } if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->fds.fd, SHUT_RD) < 0)) { readError = errno; } if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->fds.fd, SHUT_WR) < 0)) { writeError = errno; } return (readError != 0) ? readError : writeError; } /* *---------------------------------------------------------------------- * * TcpHostPortList -- * |
︙ | ︙ |
Changes to win/Makefile.in.
︙ | ︙ | |||
830 831 832 833 834 835 836 | echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi install-libraries-zipfs-shared: libraries install-libraries-zipfs-static: install-libraries-zipfs-shared | | | 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 | echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi install-libraries-zipfs-shared: libraries install-libraries-zipfs-static: install-libraries-zipfs-shared $(COPY) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" install-libraries: libraries install-tzdata install-msgs @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \ $(SCRIPT_INSTALL_DIR); \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ |
︙ | ︙ |
Changes to win/rules.vc.
︙ | ︙ | |||
1285 1286 1287 1288 1289 1290 1291 | OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS !if $(VCVERSION) >= 1600 OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1 !else OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1 !endif | < < < | | 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 | OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS !if $(VCVERSION) >= 1600 OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1 !else OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1 !endif !if $(VCVERSION) >= 1800 OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1 !endif !if $(TCL_MEM_DEBUG) OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG !endif !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS |
︙ | ︙ |
Changes to win/tclWinSock.c.
︙ | ︙ | |||
1132 1133 1134 1135 1136 1137 1138 | static int TcpClose2Proc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = instanceData; | | | < < < < | < < < < < < < | | | > > > | | | 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 | static int TcpClose2Proc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = instanceData; int readError = 0; int writeError = 0; /* * Shutdown the OS socket handle. */ if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { return TcpCloseProc(instanceData, interp); } /* * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or * TCL_WRITABLE so this should never be called for a server socket. */ if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { TclWinConvertError((DWORD) WSAGetLastError()); readError = Tcl_GetErrno(); } if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { TclWinConvertError((DWORD) WSAGetLastError()); writeError = Tcl_GetErrno(); } return (readError != 0) ? readError : writeError; } /* *---------------------------------------------------------------------- * * TcpSetOptionProc -- * |
︙ | ︙ |