Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-548 Excluding Merge-Ins
This is equivalent to a diff from 25074a8c8b to 68dda9cc0c
2019-09-14
| ||
12:41 | TIP #548 implementation: Support `wchar_t` conversion functions and deprecate `Tcl_WinUtfToTChar()` ... check-in: 2061b7bdd2 user: jan.nijtmans tags: core-8-branch | |
2019-09-13
| ||
09:14 | Merge 8.7 Closed-Leaf check-in: 68dda9cc0c user: jan.nijtmans tags: tip-548 | |
09:11 | Merge 8.6 check-in: 91a3c7f29b user: jan.nijtmans tags: core-8-branch | |
2019-09-12
| ||
14:19 | Merge 8.7 check-in: 6f354f84fd user: jan.nijtmans tags: tip-548 | |
2019-06-28
| ||
22:36 | Implement TIP #547: New encodings: UTF-16, UCS-2 check-in: 2cef9a0691 user: jan.nijtmans tags: core-8-branch | |
2019-06-26
| ||
20:08 | Merge tip-547 check-in: 6f4e263391 user: jan.nijtmans tags: tip-548 | |
20:06 | Merge 8.7 Closed-Leaf check-in: 25074a8c8b user: jan.nijtmans tags: tip-547 | |
08:32 | Merge 8.6 check-in: 34ea059cbf user: jan.nijtmans tags: core-8-branch | |
2019-06-16
| ||
11:37 | Merge 8.7 check-in: f9c29c1321 user: jan.nijtmans tags: tip-547 | |
Changes to .fossil-settings/binary-glob.
|
| | | < < < < | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 | *.a *.dll *.exe *.gif *.gz *.jpg *.lib *.pdf *.png *.xlsx *.zip |
Added .gitattributes.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | # Set the default behavior, in case people don't have core.autocrlf set. * eol=lf * text=auto # Explicitly declare text files you want to always be normalized and converted # to native line endings on checkout. *.3 text *.c text *.css text *.enc text *.h text *.htm text *.html text *.java text *.js text *.json text *.n text *.svg text *.ts text *.tcl text *.test text # Declare files that will always have CRLF line endings on checkout. *.bat eol=crlf *.sln eol=crlf *.vc eol=crlf # Denote all files that are truly binary and should not be modified. *.a binary *.dll binary *.exe binary *.gif binary *.gz binary *.jpg binary *.lib binary *.pdf binary *.png binary *.xlsx binary *.zip binary |
Added .gitignore.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | *.a *.dll *.dylib *.exe *.exp *.lib *.o *.obj *.pdb *.res *.sl *.so */Makefile */config.cache */config.log */config.status */tclConfig.sh */tclsh* */tcltest* */versions.vc */version.vc html libtommath/bn.ilg libtommath/bn.ind libtommath/pretty.build libtommath/tommath.src libtommath/*.log libtommath/*.pdf libtommath/*.pl libtommath/*.sh libtommath/doc/* libtommath/tombc/* libtommath/pre_gen/* libtommath/pics/* libtommath/mtest/* libtommath/logs/* libtommath/etc/* libtommath/demo/* libtommath/*.out libtommath/*.tex unix/autoMkindex.tcl unix/dltest.marker unix/tcl.pc unix/tclIndex unix/pkgs/* win/Debug* win/Release* win/pkgs/* win/tcl.hpj win/nmhlp-out.txt |
Changes to .travis.yml.
1 2 3 4 5 | sudo: false language: c matrix: include: | < < | < < | < < < < < | > | > | | | < | | > | > | > > | | < < < < < < > > > | | < < < < < < > > > > > | > | | | < > | | | < > | | | > > > > > > > > > > > > | > > > | | > > > > > > | | | < > | | > > | > > > | > > > > > > | | > > | > | | < > > | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > | | < < < < < < < < | > | | < < < < < < < < | > | | < < < < < < < < > | | | < < < < < < < < | | | | | < | | | > | | | > | < > > > | | > > > > | | > > | > > > > > > > > > | < < < < < > > > | > | > | < < > > > > | < | > > | | > > | < < < | | > | > > | > | < | | < < | > | | | > | > | > > | > | < | < < < < < < < < | > > > > > > > | > | > > > > > > | > > > | > > | > > | < | | 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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 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 192 193 194 195 196 197 198 199 200 201 202 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 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 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 | 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/Static" os: linux dist: xenial compiler: gcc env: - CFGOPT=--disable-shared - BUILD_DIR=unix - name: "Linux/GCC/Shared: UTF_MAX=6" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 - name: "Linux/GCC/Shared: UTF_MAX=3" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=3 - name: "Linux/GCC/Shared: NO_DEPRECATED" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_NO_DEPRECATED=1 # Debug build. Running test-cases disabled, because it is currently failing. - name: "Linux/GCC/Debug/no test" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - CFGOPT=--enable-symbols=all script: - make all tcltest # Older versions of GCC... - name: "Linux/GCC 7/Shared" os: linux dist: xenial 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: xenial 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: xenial compiler: gcc-5 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-5 env: - BUILD_DIR=unix - name: "Linux/GCC 4.9/Shared" os: linux dist: xenial compiler: gcc-4.9 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-4.9 env: - BUILD_DIR=unix # Clang - name: "Linux/Clang/Shared" os: linux dist: xenial compiler: clang env: - BUILD_DIR=unix - name: "Linux/Clang/Static" os: linux dist: xenial compiler: clang env: - CFGOPT=--disable-shared - BUILD_DIR=unix # Debug build. Running test-cases disabled, because it is currently failing. - name: "Linux/Clang/Debug/no test" os: linux dist: xenial compiler: clang env: - BUILD_DIR=unix - CFGOPT=--enable-symbols=all script: - make all tcltest # Testing on Mac, various styles - name: "macOS/Xcode 11/Shared/Unix-like" os: osx osx_image: xcode11 env: - BUILD_DIR=unix - name: "macOS/Xcode 11/Shared" os: osx osx_image: xcode11 env: - BUILD_DIR=macosx install: [] script: &mactest - make all # The styles=develop avoids some weird problems on OSX - make test styles=develop - name: "macOS/Xcode 10/Shared" os: osx osx_image: xcode10.2 env: - BUILD_DIR=macosx install: [] script: *mactest - name: "macOS/Xcode 9/Shared" os: osx osx_image: xcode9 env: - BUILD_DIR=macosx install: [] script: *mactest - name: "macOS/Xcode 8/Shared" os: osx osx_image: xcode8 env: - BUILD_DIR=macosx install: [] script: *mactest # 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: xenial compiler: x86_64-w64-mingw32-gcc addons: &mingw64 apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-x86-64 - gcc-mingw-w64-x86-64 - gcc-mingw-w64 - wine 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`" - name: "Linux-cross-Windows/GCC/Static/no test" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared" script: *crosstest - name: "Linux-cross-Windows/GCC/Shared/no test: UTF_MAX=6" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6" script: *crosstest - name: "Linux-cross-Windows/GCC/Shared/no test: UTF_MAX=3" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=3" script: *crosstest - name: "Linux-cross-Windows/GCC/Shared/no test: NO_DEPRECATED" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" script: *crosstest - name: "Linux-cross-Windows/GCC/Debug/no test" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-symbols" script: *crosstest # 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: xenial compiler: i686-w64-mingw32-gcc addons: &mingw32 apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-i686 - gcc-mingw-w64-i686 - gcc-mingw-w64 - gcc-multilib - wine env: - BUILD_DIR=win - CFGOPT=--host=i686-w64-mingw32 script: *crosstest - name: "Linux-cross-Windows-32/GCC/Static/no test" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 --disable-shared" script: *crosstest - name: "Linux-cross-Windows-32/GCC/Shared/no test: UTF_MAX=6" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6" script: *crosstest - name: "Linux-cross-Windows-32/GCC/Shared/no test: UTF_MAX=3" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=3" script: *crosstest - name: "Linux-cross-Windows-32/GCC/Shared/no test: NO_DEPRECATED" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_NO_DEPRECATED=1" script: *crosstest - name: "Linux-cross-Windows-32/GCC/Debug/no test" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 --enable-symbols" script: *crosstest # Test on Windows with MSVC native - name: "Windows/MSVC/Shared" os: windows compiler: cl env: &vcenv - 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: UTF_MAX=6" 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' - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=utfmax -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 -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=static -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 GCC native - name: "Windows/GCC/Shared" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit" before_install: - choco install make - cd ${BUILD_DIR} - name: "Windows/GCC/Shared: UTF_MAX=6" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=6" before_install: - choco install make - cd ${BUILD_DIR} - name: "Windows/GCC/Shared: UTF_MAX=3" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3" before_install: - choco install make - cd ${BUILD_DIR} - name: "Windows/GCC/Shared: NO_DEPRECATED" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" before_install: - choco install make - cd ${BUILD_DIR} - name: "Windows/GCC/Static" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit --disable-shared" before_install: - choco install make - cd ${BUILD_DIR} - name: "Windows/GCC/Debug" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit --enable-symbols" before_install: - choco install make - cd ${BUILD_DIR} before_install: - cd ${BUILD_DIR} install: - ./configure ${CFGOPT} --prefix=$HOME || (cat config.log && exit 1) before_script: - export ERROR_ON_FAILURES=1 script: - make all tcltest - make test |
Changes to compat/fake-rfc2553.c.
︙ | ︙ | |||
69 70 71 72 73 74 75 76 77 78 79 80 81 82 | int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, size_t hostlen, char *serv, size_t servlen, int flags) { struct sockaddr_in *sin = (struct sockaddr_in *)sa; struct hostent *hp; char tmpserv[16]; if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET) return (EAI_FAMILY); if (serv != NULL) { snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port)); if (strlcpy(serv, tmpserv, servlen) >= servlen) return (EAI_MEMORY); | > | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, size_t hostlen, char *serv, size_t servlen, int flags) { struct sockaddr_in *sin = (struct sockaddr_in *)sa; struct hostent *hp; char tmpserv[16]; (void)salen; if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET) return (EAI_FAMILY); if (serv != NULL) { snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port)); if (strlcpy(serv, tmpserv, servlen) >= servlen) return (EAI_MEMORY); |
︙ | ︙ | |||
149 150 151 152 153 154 155 | #ifndef HAVE_GETADDRINFO static struct addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) { struct addrinfo *ai; | | | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 | #ifndef HAVE_GETADDRINFO static struct addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) { struct addrinfo *ai; ai = (struct addrinfo *)malloc(sizeof(*ai) + sizeof(struct sockaddr_in)); if (ai == NULL) return (NULL); memset(ai, '\0', sizeof(*ai) + sizeof(struct sockaddr_in)); ai->ai_addr = (struct sockaddr *)(ai + 1); /* XXX -- ssh doesn't use sa_len */ |
︙ | ︙ |
Changes to compat/gettod.c.
︙ | ︙ | |||
17 18 19 20 21 22 23 24 25 26 | int gettimeofday( struct timeval *tp, struct timezone *tz) { struct timeb t; ftime(&t); tp->tv_sec = t.time; | > | | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | int gettimeofday( struct timeval *tp, struct timezone *tz) { struct timeb t; (void)tz; ftime(&t); tp->tv_sec = t.time; tp->tv_usec = t.millitm * 1000; return 0; } |
Changes to compat/mkstemp.c.
︙ | ︙ | |||
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 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <errno.h> #include <fcntl.h> #include <stdlib.h> #include <unistd.h> /* *---------------------------------------------------------------------- * * mkstemp -- * * Create an open temporary file from a template. * * Results: * A file descriptor, or -1 (with errno set) in the case of an error. * * Side effects: * The template is updated to contain the real filename. * *---------------------------------------------------------------------- */ int mkstemp( | > | | | | | | 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 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <errno.h> #include <fcntl.h> #include <stdlib.h> #include <unistd.h> #include <string.h> /* *---------------------------------------------------------------------- * * mkstemp -- * * Create an open temporary file from a template. * * Results: * A file descriptor, or -1 (with errno set) in the case of an error. * * Side effects: * The template is updated to contain the real filename. * *---------------------------------------------------------------------- */ int mkstemp( char *tmpl) /* Template for filename. */ { static const char alphanumerics[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; char *a, *b; int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */ a = tmpl + strlen(tmpl); while (a > tmpl && *(a-1) == 'X') { a--; } if (a == tmpl) { errno = ENOENT; return -1; } /* * We'll only try up to 10 times; after that, we're suffering from enemy * action and should let the caller know. |
︙ | ︙ | |||
67 68 69 70 71 72 73 | *b = alphanumerics[(int)(r * alphanumericsLen)]; } /* * Template is now realized; try to open (with correct options). */ | | | 68 69 70 71 72 73 74 75 76 77 78 79 | *b = alphanumerics[(int)(r * alphanumericsLen)]; } /* * Template is now realized; try to open (with correct options). */ fd = open(tmpl, O_RDWR|O_CREAT|O_EXCL, 0600); } while (fd == -1 && errno == EEXIST && --count > 0); return fd; } |
Changes to compat/opendir.c.
︙ | ︙ | |||
16 17 18 19 20 21 22 | * open a directory. */ DIR * opendir( char *name) { | | | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | * open a directory. */ DIR * opendir( char *name) { DIR *dirp; int fd; const char *myname; myname = ((*name == '\0') ? "." : name); if ((fd = open(myname, 0, 0)) == -1) { return NULL; } dirp = (DIR *) ckalloc(sizeof(DIR)); if (dirp == NULL) { |
︙ | ︙ | |||
61 62 63 64 65 66 67 | /* * get next entry in a directory. */ struct dirent * readdir( | | | | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | /* * get next entry in a directory. */ struct dirent * readdir( DIR *dirp) { struct olddirect *dp; static struct dirent dir; for (;;) { if (dirp->dd_loc == 0) { dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ); if (dirp->dd_size <= 0) { return NULL; |
︙ | ︙ | |||
97 98 99 100 101 102 103 | /* * close a directory. */ void closedir( | | | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | /* * close a directory. */ void closedir( DIR *dirp) { close(dirp->dd_fd); dirp->dd_fd = -1; dirp->dd_loc = 0; ckfree(dirp); } |
Changes to compat/stdlib.h.
1 2 3 4 5 6 7 | /* * stdlib.h -- * * Declares facilities exported by the "stdlib" portion of the C library. * This file isn't complete in the ANSI-C sense; it only declares things * that are needed by Tcl. This file is needed even on many systems with * their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * stdlib.h -- * * Declares facilities exported by the "stdlib" portion of the C library. * This file isn't complete in the ANSI-C sense; it only declares things * that are needed by Tcl. This file is needed even on many systems with * their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare * all the procedures needed here (such as strtol/strtoul). * * Copyright (c) 1991 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ |
︙ | ︙ |
Changes to compat/strstr.c.
︙ | ︙ | |||
32 33 34 35 36 37 38 | * None. * *---------------------------------------------------------------------- */ char * strstr( | | | | 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | * None. * *---------------------------------------------------------------------- */ char * strstr( char *string, /* String to search. */ char *substring) /* Substring to try to find in string. */ { char *a, *b; /* * First scan quickly through the two strings looking for a * single-character match. When it's found, then compare the rest of the * substring. */ |
︙ | ︙ |
Changes to compat/strtol.c.
︙ | ︙ | |||
41 42 43 44 45 46 47 | * character, or NULL. */ int base) /* Base for conversion. Must be less than 37. * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | * character, or NULL. */ int base) /* Base for conversion. Must be less than 37. * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { const char *p; long result; /* * Skip any leading blanks. */ p = string; |
︙ | ︙ |
Changes to compat/strtoul.c.
︙ | ︙ | |||
58 59 60 61 62 63 64 | * character, or NULL. */ int base) /* Base for conversion. Must be less than 37. * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { | | | | | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | * character, or NULL. */ int base) /* Base for conversion. Must be less than 37. * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { const char *p; unsigned long int result = 0; unsigned digit; int anyDigits = 0; int negative=0; int overflow=0; /* * Skip any leading blanks. */ |
︙ | ︙ |
Changes to compat/waitpid.c.
︙ | ︙ | |||
66 67 68 69 70 71 72 | pid_t pid, /* The pid to wait on. Must be -1 or greater * than zero. */ int *statusPtr, /* Where to store wait status for the * process. */ int options) /* OR'ed combination of WNOHANG and * WUNTRACED. */ { | | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | pid_t pid, /* The pid to wait on. Must be -1 or greater * than zero. */ int *statusPtr, /* Where to store wait status for the * process. */ int options) /* OR'ed combination of WNOHANG and * WUNTRACED. */ { WaitInfo *waitPtr, *prevPtr; pid_t result; WAIT_STATUS_TYPE status; if ((pid < -1) || (pid == 0)) { errno = EINVAL; return -1; } |
︙ | ︙ |
Changes to compat/zlib/contrib/minizip/crypt.h.
︙ | ︙ | |||
53 54 55 56 57 58 59 | */ static int update_keys(unsigned long* pkeys,const z_crc_t* pcrc_32_tab,int c) { (*(pkeys+0)) = CRC32((*(pkeys+0)), c); (*(pkeys+1)) += (*(pkeys+0)) & 0xff; (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; { | | | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | */ static int update_keys(unsigned long* pkeys,const z_crc_t* pcrc_32_tab,int c) { (*(pkeys+0)) = CRC32((*(pkeys+0)), c); (*(pkeys+1)) += (*(pkeys+0)) & 0xff; (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; { int keyshift = (int)((*(pkeys+1)) >> 24); (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift); } return c; } /*********************************************************************** |
︙ | ︙ |
Changes to compat/zlib/contrib/minizip/minizip.c.
︙ | ︙ | |||
66 67 68 69 70 71 72 | #define WRITEBUFFERSIZE (16384) #define MAXFILENAME (256) #ifdef _WIN32 uLong filetime(f, tmzip, dt) | | | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | #define WRITEBUFFERSIZE (16384) #define MAXFILENAME (256) #ifdef _WIN32 uLong filetime(f, tmzip, dt) const char *f; /* name of file to get info on */ tm_zip *tmzip; /* return value: access, modific. and creation times */ uLong *dt; /* dostime */ { int ret = 0; { FILETIME ftLocal; HANDLE hFind; WIN32_FIND_DATAA ff32; |
︙ | ︙ | |||
90 91 92 93 94 95 96 | } } return ret; } #else #if defined(unix) || defined(__APPLE__) uLong filetime(f, tmzip, dt) | | | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | } } return ret; } #else #if defined(unix) || defined(__APPLE__) uLong filetime(f, tmzip, dt) const char *f; /* name of file to get info on */ tm_zip *tmzip; /* return value: access, modific. and creation times */ uLong *dt; /* dostime */ { int ret=0; struct stat s; /* results of stat() */ struct tm* filedate; time_t tm_t=0; |
︙ | ︙ | |||
132 133 134 135 136 137 138 | tmzip->tm_mon = filedate->tm_mon ; tmzip->tm_year = filedate->tm_year; return ret; } #else uLong filetime(f, tmzip, dt) | | | | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | tmzip->tm_mon = filedate->tm_mon ; tmzip->tm_year = filedate->tm_year; return ret; } #else uLong filetime(f, tmzip, dt) const char *f; /* name of file to get info on */ tm_zip *tmzip; /* return value: access, modific. and creation times */ uLong *dt; /* dostime */ { return 0; } #endif #endif |
︙ | ︙ |
Changes to doc/Class.3.
︙ | ︙ | |||
75 76 77 78 79 80 81 | already exist. .AP int objc in The number of elements in the \fIobjv\fR array. .AP "Tcl_Obj *const" *objv in The arguments to the command to create the instance of the class. .AP int skip in The number of arguments at the start of the argument array, \fIobjv\fR, that | | > > | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | already exist. .AP int objc in The number of elements in the \fIobjv\fR array. .AP "Tcl_Obj *const" *objv in The arguments to the command to create the instance of the class. .AP int skip in The number of arguments at the start of the argument array, \fIobjv\fR, that are not arguments to any constructors. This allows the generation of correct error messages even when complicated calling patterns are used (e.g., via the \fBnext\fR command). .AP Tcl_ObjectMetadataType *metaTypePtr in The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or retrieved with \fBTcl_ClassGetMetadata\fR. .AP ClientData metadata in An item of metadata to attach to the class, or NULL to remove the metadata associated with a particular \fImetaTypePtr\fR. .AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in |
︙ | ︙ | |||
105 106 107 108 109 110 111 | with that name, and then to use \fBTcl_GetObjectAsClass\fR. .PP Every object has its own command and namespace associated with it. The command may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of the object (and hence the name of the command) with \fBTcl_GetObjectName\fR, and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR | | > > > > > > > > > > > > | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | with that name, and then to use \fBTcl_GetObjectAsClass\fR. .PP Every object has its own command and namespace associated with it. The command may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of the object (and hence the name of the command) with \fBTcl_GetObjectName\fR, and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR is a shared reference. You can also get whether the object has been marked for deletion with \fBTcl_ObjectDeleted\fR (it returns true if deletion of the object has begun); this can be useful during the processing of methods. .PP Instances of classes are created using \fBTcl_NewObjectInstance\fR, which creates an object from any class (and which is internally called by both the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes parameters that optionally give the name of the object and namespace to create, and which describe the arguments to pass to the class's constructor (if any). The result of the function will be either a reference to the newly created object, or NULL if the creation failed (when an error message will be left in the interpreter result). In addition, objects may be copied by using \fBTcl_CopyObjectInstance\fR which creates a copy of an object without running any constructors. .PP Note that the lifetime management of objects is handled internally within TclOO, and does not use \fBTcl_Preserve\fR. \fIIt is not safe to put a Tcl_Object handle in a C structure with a lifespan different to the object;\fR you should use the object's command name (as retrieved with \fBTcl_GetObjectName\fR) instead. It is safe to use a Tcl_Object handle for the lifespan of a call of a method on that object; handles do not become invalid while there is an outstanding call on their object (even if the only operation guaranteed to be safe on them is \fBTcl_ObjectDeleted\fR; the other operations are only guaranteed to work on non-deleted objects). .SH "OBJECT AND CLASS METADATA" .PP Every object and every class may have arbitrary amounts of metadata attached to it, which the object or class attaches no meaning to beyond what is described in a Tcl_ObjectMetadataType structure instance. Metadata to be attached is described by the type of the metadata (given in the \fImetaTypePtr\fR argument) and an arbitrary pointer (the \fImetadata\fR |
︙ | ︙ |
Changes to doc/Encoding.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1997-1998 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_GetEncoding 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-1998 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_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Encoding \fBTcl_GetEncoding\fR(\fIinterp, name\fR) .sp |
︙ | ︙ | |||
251 252 253 254 255 256 257 | the source buffer and up to \fIdstLen\fR converted bytes are stored in \fIdst\fR. In all cases, \fI*srcReadPtr\fR is filled with the number of bytes that were successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR is filled with the corresponding number of bytes that were stored in \fIdst\fR. The return values are the same as the return values for \fBTcl_ExternalToUtf\fR. .PP | | < | | | > > > > > > > | 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 | the source buffer and up to \fIdstLen\fR converted bytes are stored in \fIdst\fR. In all cases, \fI*srcReadPtr\fR is filled with the number of bytes that were successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR is filled with the corresponding number of bytes that were stored in \fIdst\fR. The return values are the same as the return values for \fBTcl_ExternalToUtf\fR. .PP \fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are Windows-only convenience functions for converting between UTF-8 and Windows strings based on the TCHAR type which is by convention a Unicode character on Windows NT. Those functions are deprecated. You can use \fBTcl_UtfToWCharDString\fR resp. \fBTcl_WCharToUtfDString\fR as replacement. If you want compatibility with earlier Tcl releases than 8.7, use \fBTcl_UtfToUniCharDString\fR resp. \fBTcl_UniCharToUtfDString\fR as replacement, and make sure you compile your extension with -DTCL_UTF_MAX=3. Beware: Those replacement functions don't initialize their Tcl_DString (you'll have to do that yourself), and \fBTcl_UniCharToUtfDString\fR from Tcl 8.6 doesn't accept -1 as length parameter. .PP \fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR. Given an \fIencoding\fR, the return value is the \fIname\fR argument that was used to create the encoding. The string returned by \fBTcl_GetEncodingName\fR is only guaranteed to persist until the \fIencoding\fR is deleted. The caller must not modify this string. .PP |
︙ | ︙ |
Changes to doc/Notifier.3.
︙ | ︙ | |||
128 129 130 131 132 133 134 | source must work with the notifier to detect events at the right times, record them on the event queue, and eventually notify higher-level software that they have occurred. The procedures \fBTcl_CreateEventSource\fR, \fBTcl_DeleteEventSource\fR, and \fBTcl_SetMaxBlockTime\fR, \fBTcl_QueueEvent\fR, and \fBTcl_DeleteEvents\fR are used primarily by event sources. .IP [2] | < | | | | | | | < < | | < < | 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | source must work with the notifier to detect events at the right times, record them on the event queue, and eventually notify higher-level software that they have occurred. The procedures \fBTcl_CreateEventSource\fR, \fBTcl_DeleteEventSource\fR, and \fBTcl_SetMaxBlockTime\fR, \fBTcl_QueueEvent\fR, and \fBTcl_DeleteEvents\fR are used primarily by event sources. .IP [2] The event queue: there is a single queue for each thread containing a Tcl interpreter, containing events that have been detected but not yet serviced. Event sources place events onto the queue so that they may be processed in order at appropriate times during the event loop. The event queue guarantees a fair discipline of event handling, so that no event source can starve the others. It also allows events to be saved for servicing at a future time. \fBTcl_QueueEvent\fR is used (primarily by event sources) to add events to the current thread's event queue and \fBTcl_DeleteEvents\fR is used to remove events from the queue without processing them. .IP [3] The event loop: in order to detect and process events, the application enters a loop that waits for events to occur, places them on the event queue, and then processes them. Most applications will do this by calling the procedure \fBTcl_DoOneEvent\fR, which is described in a separate manual entry. .PP |
︙ | ︙ | |||
399 400 401 402 403 404 405 | When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the event from the event queue and free its storage. Note that the storage for an event must be allocated by the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR) before calling \fBTcl_QueueEvent\fR, but it will be freed by \fBTcl_ServiceEvent\fR, not by the event source. .PP | < < < < | | 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 | When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the event from the event queue and free its storage. Note that the storage for an event must be allocated by the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR) before calling \fBTcl_QueueEvent\fR, but it will be freed by \fBTcl_ServiceEvent\fR, not by the event source. .PP Calling \fBTcl_QueueEvent\fR adds an event to the current thread's queue. To add an event to another thread's queue, use \fBTcl_ThreadQueueEvent\fR. \fBTcl_ThreadQueueEvent\fR accepts as an argument a Tcl_ThreadId argument, which uniquely identifies a thread in a Tcl application. To obtain the Tcl_ThreadId for the current thread, use the \fBTcl_GetCurrentThread\fR procedure. (A thread would then need to pass this identifier to other threads for those threads to be able to add events to its queue.) After adding an event to another thread's queue, you then typically |
︙ | ︙ | |||
494 495 496 497 498 499 500 | elapsed). Finally, a return value of \-1 means that the event loop is no longer operational and the application should probably unwind and terminate. Under Windows this happens when a WM_QUIT message is received; under Unix it happens when \fBTcl_WaitForEvent\fR would have waited forever because there were no active event sources and the timeout was infinite. .PP | | < | 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 | elapsed). Finally, a return value of \-1 means that the event loop is no longer operational and the application should probably unwind and terminate. Under Windows this happens when a WM_QUIT message is received; under Unix it happens when \fBTcl_WaitForEvent\fR would have waited forever because there were no active event sources and the timeout was infinite. .PP \fBTcl_AlertNotifier\fR is used to allow any thread to .QW "wake up" the notifier to alert it to new events on its queue. \fBTcl_AlertNotifier\fR requires as an argument the notifier handle returned by \fBTcl_InitNotifier\fR. .PP If the notifier will be used with an external event loop, then it must also support the \fBTcl_SetTimer\fR interface. \fBTcl_SetTimer\fR is |
︙ | ︙ |
Changes to doc/OpenFileChnl.3.
︙ | ︙ | |||
273 274 275 276 277 278 279 | error for argc and argv to override stdio channels for which \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, and \fBTCL_STDERR\fR have been set. .PP If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR returns NULL and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in | | | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | error for argc and argv to override stdio channels for which \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, and \fBTCL_STDERR\fR have been set. .PP If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR returns NULL and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in the interpreter's result. \fIinterp\fR cannot be NULL. .PP The newly created channel is not registered in the supplied interpreter; to register it, use \fBTcl_RegisterChannel\fR, described below. If one of the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was previously closed, the act of creating the new channel also assigns it as a replacement for the standard channel. .SH TCL_MAKEFILECHANNEL |
︙ | ︙ |
Changes to doc/StringObj.3.
︙ | ︙ | |||
87 88 89 90 91 92 93 | .SH ARGUMENTS .AS "const Tcl_UniChar" *appendObjPtr in/out .AP "const char" *bytes in Points to the first byte of an array of UTF-8-encoded bytes used to set or append to a string value. This byte array may contain embedded null characters unless \fInumChars\fR is negative. (Applications needing null bytes | | | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | .SH ARGUMENTS .AS "const Tcl_UniChar" *appendObjPtr in/out .AP "const char" *bytes in Points to the first byte of an array of UTF-8-encoded bytes used to set or append to a string value. This byte array may contain embedded null characters unless \fInumChars\fR is negative. (Applications needing null bytes should represent them as the two-byte sequence \fI\e300\e200\fR, use \fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if the string is a collection of uninterpreted bytes.) .AP int length in The number of bytes to copy from \fIbytes\fR when initializing, setting, or appending to a string value. If negative, all bytes up to the first null are used. .AP "const Tcl_UniChar" *unicode in |
︙ | ︙ |
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 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 | '\" '\" 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_WCharToUtfDString, Tcl_UtfToWCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToChar16DString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp typedef ... \fBTcl_UniChar\fR; .sp int \fBTcl_UniCharToUtf\fR(\fIch, buf\fR) .sp int \fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR) .sp int \fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR) .sp int \fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR) .sp char * \fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR) .sp char * \fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR) .sp char * \fBTcl_WCharToUtfDString\fR(\fIwStr, uniLength, dsPtr\fR) .sp Tcl_UniChar * \fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR) .sp unsigned short * \fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR) .sp wchar_t * \fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR) .sp int \fBTcl_UniCharLen\fR(\fIuniStr\fR) .sp int \fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR) .sp int |
︙ | ︙ | |||
71 72 73 74 75 76 77 | .sp int \fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *uniPattern in/out .AP char *buf out Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most | | > > > > > > > > | < | | < | | | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | .sp int \fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *uniPattern in/out .AP char *buf out Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most 4 bytes are stored in the buffer. .AP int ch in The Unicode character to be converted or examined. .AP Tcl_UniChar *chPtr out Filled with the Tcl_UniChar represented by the head of the UTF-8 string. .AP unsigned short *uPtr out Filled with the utf-16 represented by the head of the UTF-8 string. .AP wchar_t *wPtr out Filled with the wchar_t represented by the head of the UTF-8 string. .AP "const char" *src in Pointer to a UTF-8 string. .AP "const char" *cs in Pointer to a UTF-8 string. .AP "const char" *ct in Pointer to a UTF-8 string. .AP "const Tcl_UniChar" *uniStr in A null-terminated Unicode string. .AP "const Tcl_UniChar" *ucs in A null-terminated Unicode string. .AP "const Tcl_UniChar" *uct in 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 int 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 int 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. .AP "unsigned long" numChars in The number of characters to compare. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. .AP int index in The index of a character (not byte) in the UTF-8 string. .AP int *readPtr out If non-NULL, filled with the number of bytes in the backslash sequence, including the backslash character. .AP char *dst out Buffer in which the bytes represented by the backslash sequence are stored. At most 4 bytes are stored in the buffer. .AP int nocase in Specifies whether the match should be done case-sensitive (0) or 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 \fBTCL_UTF_MAX\fR bytes. A multibyte UTF-8 sequence consists of a lead byte followed by some number of trail bytes. .PP \fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to represent one Unicode character in the UTF-8 representation. .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 |
︙ | ︙ | |||
144 145 146 147 148 149 150 | source buffer is long enough such that this routine does not run off the end and dereference non-existent or random memory; if the source buffer is known to be null-terminated, this will not happen. If the input is a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR and returns 1. If the input is otherwise not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first | | | < | 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 | source buffer is long enough such that this routine does not run off the end and dereference non-existent or random memory; if the source buffer is known to be null-terminated, this will not happen. If the input is a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR and returns 1. If the input is otherwise not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x00A0 and 0x00FF and return 1. .PP \fBTcl_UniCharToUtfDString\fR converts the given Unicode string to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR. The return value is a pointer to the UTF-8 representation of the Unicode string. Storage for the return value is appended to the end of the \fBTcl_DString\fR. .PP \fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode, storing the result in the previously initialized \fBTcl_DString\fR. In the argument \fIlength\fR, you may either specify the length of |
︙ | ︙ | |||
249 250 251 252 253 254 255 | contain at least \fIindex\fR characters. This is equivalent to calling \fBTcl_UtfNext\fR \fIindex\fR times. If a negative \fIindex\fR is given, the return pointer points to the first character in the source string. .PP \fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl commands. It parses a backslash sequence and stores the properly formed UTF-8 character represented by the backslash sequence in the output | | | 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 | contain at least \fIindex\fR characters. This is equivalent to calling \fBTcl_UtfNext\fR \fIindex\fR times. If a negative \fIindex\fR is given, the return pointer points to the first character in the source string. .PP \fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl commands. It parses a backslash sequence and stores the properly formed UTF-8 character represented by the backslash sequence in the output buffer \fIdst\fR. At most 4 bytes are stored in the buffer. \fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number of bytes in the backslash sequence, including the backslash character. The return value is the number of bytes stored in the output buffer. .PP See the \fBTcl\fR manual entry for information on the valid backslash sequences. All of the sequences described in the Tcl manual entry are supported by \fBTcl_UtfBackslash\fR. .SH KEYWORDS utf, unicode, backslash |
Changes to doc/cd.n.
︙ | ︙ | |||
18 19 20 21 22 23 24 | .PP Change the current working directory to \fIdirName\fR, or to the home directory (as specified in the HOME environment variable) if \fIdirName\fR is not given. Returns an empty string. Note that the current working directory is a per-process resource; the \fBcd\fR command changes the working directory for all interpreters | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | .PP Change the current working directory to \fIdirName\fR, or to the home directory (as specified in the HOME environment variable) if \fIdirName\fR is not given. Returns an empty string. Note that the current working directory is a per-process resource; the \fBcd\fR command changes the working directory for all interpreters and all threads. .SH EXAMPLES .PP Change to the home directory of the user \fBfred\fR: .PP .CS \fBcd\fR ~fred .CE |
︙ | ︙ |
Changes to doc/source.n.
︙ | ︙ | |||
39 40 41 42 43 44 45 | in code for string comparison, you can use .QW \e032 or .QW \eu001a , which will be safely substituted by the Tcl interpreter into .QW ^Z . .PP | | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | in code for string comparison, you can use .QW \e032 or .QW \eu001a , which will be safely substituted by the Tcl interpreter into .QW ^Z . .PP A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, utf-16, ucs-2). .PP The \fB\-encoding\fR option is used to specify the encoding of the data stored in \fIfileName\fR. When the \fB\-encoding\fR option is omitted, the system encoding is assumed. .SH EXAMPLE .PP Run the script in the file \fBfoo.tcl\fR and then the script in the |
︙ | ︙ |
Changes to doc/string.n.
︙ | ︙ | |||
358 359 360 361 362 363 364 | specified using the forms described in \fBSTRING INDICES\fR. .TP \fBstring trim \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any leading or trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character | | | | | 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 | specified using the forms described in \fBSTRING INDICES\fR. .TP \fBstring trim \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any leading or trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character for which \fBstring is space\fR returns 1, and "\e0"). .TP \fBstring trimleft \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any leading characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character for which \fBstring is space\fR returns 1, and "\e0"). .TP \fBstring trimright \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character for which \fBstring is space\fR returns 1, and "\e0"). .SS "OBSOLETE SUBCOMMANDS" .PP These subcommands are currently supported, but are likely to go away in a future release as their functionality is either virtually never used or highly misleading. .TP \fBstring bytelength \fIstring\fR |
︙ | ︙ |
Changes to generic/regc_lex.c.
︙ | ︙ | |||
901 902 903 904 905 906 907 | /* * Oops, doesn't look like it's a backref after all... */ v->now = save; | | < < | 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 | /* * Oops, doesn't look like it's a backref after all... */ v->now = save; /* FALLTHRU */ case CHR('0'): NOTE(REG_UUNPORT); v->now--; /* put first digit back */ c = (uchr) lexdigits(v, 8, 1, 3); if (ISERR()) { FAILW(REG_EESCAPE); |
︙ | ︙ |
Changes to generic/regc_nfa.c.
︙ | ︙ | |||
2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 | narcs += s->nouts; } fprintf(f, "total of %d states, %d arcs\n", nstates, narcs); if (nfa->parent == NULL) { dumpcolors(nfa->cm, f); } fflush(f); #endif } #ifdef REG_DEBUG /* subordinates of dumpnfa */ /* ^ #ifdef REG_DEBUG */ | > > > | 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 | narcs += s->nouts; } fprintf(f, "total of %d states, %d arcs\n", nstates, narcs); if (nfa->parent == NULL) { dumpcolors(nfa->cm, f); } fflush(f); #else (void)nfa; (void)f; #endif } #ifdef REG_DEBUG /* subordinates of dumpnfa */ /* ^ #ifdef REG_DEBUG */ |
︙ | ︙ | |||
3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 | fprintf(f, ", haslacons"); } fprintf(f, "\n"); for (st = 0; st < cnfa->nstates; st++) { dumpcstate(st, cnfa, f); } fflush(f); #endif } #ifdef REG_DEBUG /* subordinates of dumpcnfa */ /* ^ #ifdef REG_DEBUG */ | > > > | 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 | fprintf(f, ", haslacons"); } fprintf(f, "\n"); for (st = 0; st < cnfa->nstates; st++) { dumpcstate(st, cnfa, f); } fflush(f); #else (void)cnfa; (void)f; #endif } #ifdef REG_DEBUG /* subordinates of dumpcnfa */ /* ^ #ifdef REG_DEBUG */ |
︙ | ︙ |
Changes to generic/regcomp.c.
︙ | ︙ | |||
55 56 57 58 59 60 61 | static const chr *scanplain(struct vars *); static void onechr(struct vars *, pchr, struct state *, struct state *); static void dovec(struct vars *, struct cvec *, struct state *, struct state *); static void wordchrs(struct vars *); static struct subre *subre(struct vars *, int, int, struct state *, struct state *); static void freesubre(struct vars *, struct subre *); static void freesrnode(struct vars *, struct subre *); | < | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | static const chr *scanplain(struct vars *); static void onechr(struct vars *, pchr, struct state *, struct state *); static void dovec(struct vars *, struct cvec *, struct state *, struct state *); static void wordchrs(struct vars *); static struct subre *subre(struct vars *, int, int, struct state *, struct state *); static void freesubre(struct vars *, struct subre *); static void freesrnode(struct vars *, struct subre *); static int numst(struct subre *, int); static void markst(struct subre *); static void cleanst(struct vars *); static long nfatree(struct vars *, struct subre *, FILE *); static long nfanode(struct vars *, struct subre *, FILE *); static int newlacon(struct vars *, struct state *, struct state *, int); static void freelacons(struct subre *, int); |
︙ | ︙ | |||
390 391 392 393 394 395 396 | specialcolors(v->nfa); CNOERR(); if (debug != NULL) { fprintf(debug, "\n\n\n========= RAW ==========\n"); dumpnfa(v->nfa, debug); dumpst(v->tree, debug, 1); } | < | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 | specialcolors(v->nfa); CNOERR(); if (debug != NULL) { fprintf(debug, "\n\n\n========= RAW ==========\n"); dumpnfa(v->nfa, debug); dumpst(v->tree, debug, 1); } v->ntree = numst(v->tree, 1); markst(v->tree); cleanst(v); if (debug != NULL) { fprintf(debug, "\n\n\n========= TREE FIXED ==========\n"); dumpst(v->tree, debug, 1); } |
︙ | ︙ | |||
508 509 510 511 512 513 514 | ^ static int freev(struct vars *, int); */ static int freev( struct vars *v, int err) { | | | 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | ^ static int freev(struct vars *, int); */ static int freev( struct vars *v, int err) { int ret; if (v->re != NULL) { rfree(v->re); } if (v->subs != v->sub10) { FREE(v->subs); } |
︙ | ︙ | |||
918 919 920 921 922 923 924 | } /* * Legal in EREs due to specification botch. */ NOTE(REG_UPBOTCH); | | | 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 | } /* * Legal in EREs due to specification botch. */ NOTE(REG_UPBOTCH); /* FALLTHRU */ case PLAIN: onechr(v, v->nextvalue, lp, rp); okcolors(v->nfa, v->cm); NOERR(); NEXT(); break; case '[': |
︙ | ︙ | |||
1805 1806 1807 1808 1809 1810 1811 | /* we're still parsing, maybe we can reuse the subre */ sr->left = v->treefree; v->treefree = sr; } else { FREE(sr); } } | < < < < < < < < < < < < < < < < < < < | 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 | /* we're still parsing, maybe we can reuse the subre */ sr->left = v->treefree; v->treefree = sr; } else { FREE(sr); } } /* - numst - number tree nodes (assigning "id" indexes) ^ static int numst(struct subre *, int); */ static int /* next number */ numst( |
︙ | ︙ | |||
2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 | for (i = 1; i < g->nlacons; i++) { fprintf(f, "\nla%d (%s):\n", i, (g->lacons[i].subno) ? "positive" : "negative"); dumpcnfa(&g->lacons[i].cnfa, f); } fprintf(f, "\n"); dumpst(g->tree, f, 0); #endif } /* - dumpst - dump a subRE tree ^ static void dumpst(struct subre *, FILE *, int); */ | > > > | 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 | for (i = 1; i < g->nlacons; i++) { fprintf(f, "\nla%d (%s):\n", i, (g->lacons[i].subno) ? "positive" : "negative"); dumpcnfa(&g->lacons[i].cnfa, f); } fprintf(f, "\n"); dumpst(g->tree, f, 0); #else (void)re; (void)f; #endif } /* - dumpst - dump a subRE tree ^ static void dumpst(struct subre *, FILE *, int); */ |
︙ | ︙ |
Changes to generic/regcustom.h.
︙ | ︙ | |||
127 128 129 130 131 132 133 | * space to store this because the regular expression engine is never * reentered from the same thread; it doesn't make any callbacks. */ #if 1 #define AllocVars(vPtr) \ static Tcl_ThreadDataKey varsKey; \ | | | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 | * space to store this because the regular expression engine is never * reentered from the same thread; it doesn't make any callbacks. */ #if 1 #define AllocVars(vPtr) \ static Tcl_ThreadDataKey varsKey; \ struct vars *vPtr = (struct vars *) \ Tcl_GetThreadData(&varsKey, sizeof(struct vars)) #else /* * This strategy for allocating workspace is "more proper" in some sense, but * quite a bit slower. Using TSD (as above) leads to code that is quite a bit * faster in practice (measured!) */ #define AllocVars(vPtr) \ struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) #define FreeVars(vPtr) \ FREE(vPtr) #endif /* * Local Variables: * mode: c |
︙ | ︙ |
Changes to generic/regerror.c.
︙ | ︙ | |||
54 55 56 57 58 59 60 | /* - regerror - the interface to error numbers */ /* ARGSUSED */ size_t /* Actual space needed (including NUL) */ regerror( int code, /* Error code, or REG_ATOI or REG_ITOA */ | < | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | /* - regerror - the interface to error numbers */ /* ARGSUSED */ size_t /* Actual space needed (including NUL) */ regerror( int code, /* Error code, or REG_ATOI or REG_ITOA */ char *errbuf, /* Result buffer (unless errbuf_size==0) */ size_t errbuf_size) /* Available space in errbuf, can be 0 */ { const struct rerr *r; const char *msg; char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */ size_t len; |
︙ | ︙ |
Changes to generic/regex.h.
︙ | ︙ | |||
147 148 149 150 151 152 153 | #define REG_ULOCALE 002000 #define REG_UEMPTYMATCH 004000 #define REG_UIMPOSSIBLE 010000 #define REG_USHORTEST 020000 int re_csize; /* sizeof(character) */ char *re_endp; /* backward compatibility kludge */ /* the rest is opaque pointers to hidden innards */ | | | | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | #define REG_ULOCALE 002000 #define REG_UEMPTYMATCH 004000 #define REG_UIMPOSSIBLE 010000 #define REG_USHORTEST 020000 int re_csize; /* sizeof(character) */ char *re_endp; /* backward compatibility kludge */ /* the rest is opaque pointers to hidden innards */ void *re_guts; void *re_fns; } regex_t; /* result reporting (may acquire more fields later) */ typedef struct { regoff_t rm_so; /* start of substring */ regoff_t rm_eo; /* end of substring */ } regmatch_t; |
︙ | ︙ | |||
228 229 230 231 232 233 234 | * Be careful if modifying the list of error codes -- the table used by * regerror() is generated automatically from this file! * * Note that there is no wide-char variant of regerror at this time; what kind * of character is used for error reports is independent of what kind is used * in matching. * | | | 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 | * Be careful if modifying the list of error codes -- the table used by * regerror() is generated automatically from this file! * * Note that there is no wide-char variant of regerror at this time; what kind * of character is used for error reports is independent of what kind is used * in matching. * ^ extern size_t regerror(int, char *, size_t); */ #define REG_OKAY 0 /* no errors detected */ #define REG_NOMATCH 1 /* failed to match */ #define REG_BADPAT 2 /* invalid regexp */ #define REG_ECOLLATE 3 /* invalid collating element */ #define REG_ECTYPE 4 /* invalid character class */ #define REG_EESCAPE 5 /* invalid escape \ sequence */ |
︙ | ︙ | |||
279 280 281 282 283 284 285 | #ifndef __REG_NOFRONT int regexec(regex_t *, const char *, size_t, regmatch_t [], int); #endif #ifdef __REG_WIDE_T MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif MODULE_SCOPE void regfree(regex_t *); | | | 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 | #ifndef __REG_NOFRONT int regexec(regex_t *, const char *, size_t, regmatch_t [], int); #endif #ifdef __REG_WIDE_T MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif MODULE_SCOPE void regfree(regex_t *); MODULE_SCOPE size_t regerror(int, char *, size_t); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ /* * more C++ voodoo */ #ifdef __cplusplus |
︙ | ︙ |
Changes to generic/regexec.c.
︙ | ︙ | |||
87 88 89 90 91 92 93 | struct smalldfa { struct dfa dfa; struct sset ssets[FEWSTATES*2]; unsigned statesarea[FEWSTATES*2 + WORK]; struct sset *outsarea[FEWSTATES*2 * FEWCOLORS]; struct arcp incarea[FEWSTATES*2 * FEWCOLORS]; }; | < | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | struct smalldfa { struct dfa dfa; struct sset ssets[FEWSTATES*2]; unsigned statesarea[FEWSTATES*2 + WORK]; struct sset *outsarea[FEWSTATES*2 * FEWCOLORS]; struct arcp incarea[FEWSTATES*2 * FEWCOLORS]; }; /* * Internal variables, bundled for easy passing around. */ struct vars { regex_t *re; |
︙ | ︙ | |||
125 126 127 128 129 130 131 | /* =====^!^===== begin forwards =====^!^===== */ /* automatically gathered by fwd; do not hand-edit */ /* === regexec.c === */ int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int); static struct dfa *getsubdfa(struct vars *, struct subre *); static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const); static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const); | | | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | /* =====^!^===== begin forwards =====^!^===== */ /* automatically gathered by fwd; do not hand-edit */ /* === regexec.c === */ int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int); static struct dfa *getsubdfa(struct vars *, struct subre *); static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const); static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const); static int complicatedFindLoop(struct vars *const, struct dfa *const, struct dfa *const, chr **const); static void zapallsubs(regmatch_t *const, const size_t); static void zaptreesubs(struct vars *const, struct subre *const); static void subset(struct vars *const, struct subre *const, chr *const, chr *const); static int cdissect(struct vars *, struct subre *, chr *, chr *); static int ccondissect(struct vars *, struct subre *, chr *, chr *); static int crevcondissect(struct vars *, struct subre *, chr *, chr *); static int cbrdissect(struct vars *, struct subre *, chr *, chr *); |
︙ | ︙ | |||
295 296 297 298 299 300 301 | * The DFA will be freed by the cleanup step in exec(). */ static struct dfa * getsubdfa(struct vars * v, struct subre * t) { if (v->subdfas[t->id] == NULL) { | | | 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 | * The DFA will be freed by the cleanup step in exec(). */ static struct dfa * getsubdfa(struct vars * v, struct subre * t) { if (v->subdfas[t->id] == NULL) { v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, NULL); if (ISERR()) return NULL; } return v->subdfas[t->id]; } /* |
︙ | ︙ | |||
430 431 432 433 434 435 436 | d = newDFA(v, cnfa, cm, &v->dfa2); if (ISERR()) { assert(d == NULL); freeDFA(s); return v->err; } | | | < < | 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 | d = newDFA(v, cnfa, cm, &v->dfa2); if (ISERR()) { assert(d == NULL); freeDFA(s); return v->err; } ret = complicatedFindLoop(v, d, s, &cold); freeDFA(d); freeDFA(s); NOERR(); if (v->g->cflags®_EXPECT) { assert(v->details != NULL); if (cold != NULL) { v->details->rm_extend.rm_so = OFF(cold); } else { v->details->rm_extend.rm_so = OFF(v->stop); } v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */ } return ret; } /* - complicatedFindLoop - the heart of complicatedFind ^ static int complicatedFindLoop(struct vars *, ^ struct dfa *, struct dfa *, chr **); */ static int complicatedFindLoop( struct vars *const v, struct dfa *const d, struct dfa *const s, chr **const coldp) /* where to put coldstart pointer */ { chr *begin, *end; chr *cold; chr *open, *close; /* Open and close of range of possible |
︙ | ︙ |
Changes to generic/regguts.h.
︙ | ︙ | |||
407 408 409 410 411 412 413 | * Magic for allocating a variable workspace. This default version is * stack-hungry. */ #ifndef AllocVars #define AllocVars(vPtr) \ struct vars var; \ | | | 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 | * Magic for allocating a variable workspace. This default version is * stack-hungry. */ #ifndef AllocVars #define AllocVars(vPtr) \ struct vars var; \ struct vars *vPtr = &var #endif #ifndef FreeVars #define FreeVars(vPtr) ((void) 0) #endif /* * Local Variables: |
︙ | ︙ |
Changes to generic/tcl.decls.
︙ | ︙ | |||
1194 1195 1196 1197 1198 1199 1200 | declare 334 { int Tcl_UtfToLower(char *src) } declare 335 { int Tcl_UtfToTitle(char *src) } declare 336 { | | | 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 | declare 334 { int Tcl_UtfToLower(char *src) } declare 335 { int Tcl_UtfToTitle(char *src) } declare 336 { int Tcl_UtfToChar16(const char *src, unsigned short *chPtr) } declare 337 { int Tcl_UtfToUpper(char *src) } declare 338 { int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen) } |
︙ | ︙ | |||
1249 1250 1251 1252 1253 1254 1255 | int Tcl_UniCharLen(const Tcl_UniChar *uniStr) } declare 353 { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars) } declare 354 { | | | | 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 | int Tcl_UniCharLen(const Tcl_UniChar *uniStr) } declare 353 { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars) } declare 354 { char *Tcl_Char16ToUtfDString(const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr) } declare 355 { unsigned short *Tcl_UtfToChar16DString(const char *src, int length, Tcl_DString *dsPtr) } declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { |
︙ | ︙ | |||
2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 | int type, int size) } declare 645 { int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr) } # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. | > > > > > > > > > > > > > | 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 | int type, int size) } declare 645 { int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr) } # TIP #548 declare 646 { int Tcl_UtfToUniChar(const char *src, int *chPtr) } declare 647 { char *Tcl_UniCharToUtfDString(const int *uniStr, int uniLength, Tcl_DString *dsPtr) } declare 648 { int *Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr) } # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
402 403 404 405 406 407 408 | #define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) #define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) #define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #if defined(_WIN32) # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; | | | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 | #define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) #define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) #define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #if defined(_WIN32) # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; # elif defined(_WIN64) || defined(_USE_64BIT_TIME_T) typedef struct __stat64 Tcl_StatBuf; # elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T) typedef struct _stati64 Tcl_StatBuf; # else typedef struct _stat32i64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ #elif defined(__CYGWIN__) |
︙ | ︙ | |||
2150 2151 2152 2153 2154 2155 2156 | /* * This represents a Unicode character. Any changes to this should also be * reflected in regcustom.h. */ #if TCL_UTF_MAX > 4 /* | | | | 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 | /* * This represents a Unicode character. Any changes to this should also be * reflected in regcustom.h. */ #if TCL_UTF_MAX > 4 /* * int isn't 100% accurate as it should be a strict 4-byte value * (perhaps wchar_t). 64-bit systems may have troubles. The size of this * value must be reflected correctly in regcustom.h and * in tclEncoding.c. * XXX: Tcl is currently UCS-2 and planning UTF-16 for the Unicode * XXX: string rep that Tcl_UniChar represents. Changing the size * XXX: of Tcl_UniChar is /not/ supported. */ typedef int Tcl_UniChar; #else typedef unsigned short Tcl_UniChar; #endif /* *---------------------------------------------------------------------------- * TIP #59: The following structure is used in calls 'Tcl_RegisterConfig' to |
︙ | ︙ |
Changes to generic/tclAlloc.c.
︙ | ︙ | |||
249 250 251 252 253 254 255 | *---------------------------------------------------------------------- */ char * TclpAlloc( unsigned int numBytes) /* Number of bytes to allocate. */ { | | | | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 | *---------------------------------------------------------------------- */ char * TclpAlloc( unsigned int numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; unsigned amount; struct block *bigBlockPtr = NULL; if (!allocInit) { /* * We have to make the "self initializing" because Tcl_Alloc may be * used before any other part of Tcl. E.g., see main() for tclsh! */ |
︙ | ︙ | |||
300 301 302 303 304 305 306 | overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); overPtr->rangeCheckMagic = RMAGIC; BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); | | | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); overPtr->rangeCheckMagic = RMAGIC; BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); return (char *)(overPtr+1); } /* * Convert amount of memory requested into closest block size stored in * hash buckets which satisfies request. Account for space used per block * for accounting. */ |
︙ | ︙ | |||
383 384 385 386 387 388 389 | *---------------------------------------------------------------------- */ static void MoreCore( size_t bucket) /* What bucket to allocate to. */ { | | | | 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | *---------------------------------------------------------------------- */ static void MoreCore( size_t bucket) /* What bucket to allocate to. */ { union overhead *overPtr; size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; /* * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a * VAX, I think) or for a negative arg. |
︙ | ︙ | |||
444 445 446 447 448 449 450 | *---------------------------------------------------------------------- */ void TclpFree( char *oldPtr) /* Pointer to memory to free. */ { | | | | 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 | *---------------------------------------------------------------------- */ void TclpFree( char *oldPtr) /* Pointer to memory to free. */ { size_t size; union overhead *overPtr; struct block *bigBlockPtr; if (oldPtr == NULL) { return; } Tcl_MutexLock(allocMutexPtr); |
︙ | ︙ | |||
588 589 590 591 592 593 594 | if (numBytes+OVERHEAD > maxSize) { expensive = 1; } else if (i>0 && numBytes+OVERHEAD < maxSize/2) { expensive = 1; } if (expensive) { | | | 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 | if (numBytes+OVERHEAD > maxSize) { expensive = 1; } else if (i>0 && numBytes+OVERHEAD < maxSize/2) { expensive = 1; } if (expensive) { char *newPtr; Tcl_MutexUnlock(allocMutexPtr); newPtr = TclpAlloc(numBytes); if (newPtr == NULL) { return NULL; } |
︙ | ︙ | |||
641 642 643 644 645 646 647 | */ #ifdef MSTATS void mstats( char *s) /* Where to write info. */ { | | | | 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 | */ #ifdef MSTATS void mstats( char *s) /* Where to write info. */ { unsigned int i, j; union overhead *overPtr; size_t totalFree = 0, totalUsed = 0; Tcl_MutexLock(allocMutexPtr); fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s); for (i = 0; i < NBUCKETS; i++) { for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) { |
︙ | ︙ |
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
283 284 285 286 287 288 289 | static void FreeAssemblyEnv(AssemblyEnv*); static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**); static void LookForFreshCatches(BasicBlock*, BasicBlock**); static void MoveCodeForJumps(AssemblyEnv*, int); | | < | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 | static void FreeAssemblyEnv(AssemblyEnv*); static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**); static void LookForFreshCatches(BasicBlock*, BasicBlock**); static void MoveCodeForJumps(AssemblyEnv*, int); static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int); static AssemblyEnv* NewAssemblyEnv(CompileEnv*, int); static int ProcessCatches(AssemblyEnv*); static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*, BasicBlock*, enum BasicBlockCatchState, int); static void ResetVisitedBasicBlocks(AssemblyEnv*); static void ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*); static void ReportUndefinedLabel(AssemblyEnv*, BasicBlock*, |
︙ | ︙ | |||
502 503 504 505 506 507 508 | {"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0}, {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0}, {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0}, {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1}, | | | 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 | {"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0}, {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0}, {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0}, {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1}, {NULL, ASSEM_1BYTE, 0, 0, 0} }; /* * List of instructions that cannot throw an exception under any * circumstances. These instructions are the ones that are permissible after * an exception is caught but before the corresponding exception range is * popped from the stack. |
︙ | ︙ | |||
793 794 795 796 797 798 799 800 801 802 803 804 805 806 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ByteCode *codePtr; /* Pointer to the bytecode to execute */ Tcl_Obj* backtrace; /* Object where extra error information is * constructed. */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList"); return TCL_ERROR; } /* * Assemble the source to bytecode. | > | 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ByteCode *codePtr; /* Pointer to the bytecode to execute */ Tcl_Obj* backtrace; /* Object where extra error information is * constructed. */ (void)dummy; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList"); return TCL_ERROR; } /* * Assemble the source to bytecode. |
︙ | ︙ | |||
849 850 851 852 853 854 855 | CompileAssembleObj( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Source code to assemble */ { Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ | | | 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 | CompileAssembleObj( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Source code to assemble */ { Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ Namespace* namespacePtr; /* Namespace in which variable and command * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ int sourceLen; /* Length of the source code in bytes */ |
︙ | ︙ | |||
966 967 968 969 970 971 972 | CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; /* Token in the input script */ int numCommands = envPtr->numCommands; int offset = envPtr->codeNext - envPtr->codeStart; int depth = envPtr->currStackDepth; | | | 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 | CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; /* Token in the input script */ int numCommands = envPtr->numCommands; int offset = envPtr->codeNext - envPtr->codeStart; int depth = envPtr->currStackDepth; (void)cmdPtr; /* * Make sure that the command has a single arg that is a simple word. */ if (parsePtr->numWords != 2) { return TCL_ERROR; } |
︙ | ︙ | |||
1151 1152 1153 1154 1155 1156 1157 | NewAssemblyEnv( CompileEnv* envPtr, /* Compilation environment being used for code * generation*/ int flags) /* Compilation flags (TCL_EVAL_DIRECT) */ { Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ | | | | 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 | NewAssemblyEnv( CompileEnv* envPtr, /* Compilation environment being used for code * generation*/ int flags) /* Compilation flags (TCL_EVAL_DIRECT) */ { Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ AssemblyEnv* assemEnvPtr = (AssemblyEnv*)TclStackAlloc(interp, sizeof(AssemblyEnv)); /* Assembler environment under construction */ Tcl_Parse* parsePtr = (Tcl_Parse*)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Parse of one line of assembly code */ assemEnvPtr->envPtr = envPtr; assemEnvPtr->parsePtr = parsePtr; assemEnvPtr->cmdLine = 1; assemEnvPtr->clNext = envPtr->clNext; |
︙ | ︙ | |||
1542 1543 1544 1545 1546 1547 1548 | Tcl_WrongNumArgs(interp, 1, &instNameObj, "table"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } | | | 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 | Tcl_WrongNumArgs(interp, 1, &instNameObj, "table"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart; DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n", assemEnvPtr->curr_bb, assemEnvPtr->cmdLine, envPtr->codeNext - envPtr->codeStart); |
︙ | ︙ | |||
1816 1817 1818 1819 1820 1821 1822 | * We'll record the stack usage of the script in the BasicBlock, and * accumulate it together with the stack usage of the enclosing assembly * code. */ int savedStackDepth = envPtr->currStackDepth; int savedMaxStackDepth = envPtr->maxStackDepth; | < | 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 | * We'll record the stack usage of the script in the BasicBlock, and * accumulate it together with the stack usage of the enclosing assembly * code. */ int savedStackDepth = envPtr->currStackDepth; int savedMaxStackDepth = envPtr->maxStackDepth; int savedExceptArrayNext = envPtr->exceptArrayNext; envPtr->currStackDepth = 0; envPtr->maxStackDepth = 0; StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); switch(instPtr->tclInstCode) { |
︙ | ︙ | |||
1849 1850 1851 1852 1853 1854 1855 | envPtr->maxStackDepth = savedMaxStackDepth; /* * Save any exception ranges that were pushed by the compiler; they will * need to be fixed up once the stack depth is known. */ | | < | 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 | envPtr->maxStackDepth = savedMaxStackDepth; /* * Save any exception ranges that were pushed by the compiler; they will * need to be fixed up once the stack depth is known. */ MoveExceptionRangesToBasicBlock(assemEnvPtr, savedExceptArrayNext); /* * Flush the current basic block. */ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); } |
︙ | ︙ | |||
1909 1910 1911 1912 1913 1914 1915 | * *----------------------------------------------------------------------------- */ static void MoveExceptionRangesToBasicBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ | < | 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 | * *----------------------------------------------------------------------------- */ static void MoveExceptionRangesToBasicBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ int savedExceptArrayNext) /* Saved index of the end of the exception * range array */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* curr_bb = assemEnvPtr->curr_bb; /* Current basic block */ |
︙ | ︙ | |||
1941 1942 1943 1944 1945 1946 1947 | */ DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n", curr_bb, exceptionCount, savedExceptArrayNext); curr_bb->foreignExceptionBase = savedExceptArrayNext; curr_bb->foreignExceptionCount = exceptionCount; curr_bb->foreignExceptions = | | | 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 | */ DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n", curr_bb, exceptionCount, savedExceptArrayNext); curr_bb->foreignExceptionBase = savedExceptArrayNext; curr_bb->foreignExceptionCount = exceptionCount; curr_bb->foreignExceptions = (ExceptionRange*)ckalloc(exceptionCount * sizeof(ExceptionRange)); memcpy(curr_bb->foreignExceptions, envPtr->exceptArrayPtr + savedExceptArrayNext, exceptionCount * sizeof(ExceptionRange)); for (i = 0; i < exceptionCount; ++i) { curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth; } envPtr->exceptArrayNext = savedExceptArrayNext; |
︙ | ︙ | |||
2006 2007 2008 2009 2010 2011 2012 | return TCL_ERROR; } /* * Allocate the jumptable. */ | | | 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 | return TCL_ERROR; } /* * Allocate the jumptable. */ jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo)); jtHashPtr = &jtPtr->hashTable; Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS); /* * Fill the keys and labels into the table. */ |
︙ | ︙ | |||
2066 2067 2068 2069 2070 2071 2072 | Tcl_HashSearch search; /* Hash search control */ Tcl_HashEntry* entry; /* Hash table entry containing a jump label */ Tcl_Obj* label; /* Jump label from the hash table */ for (entry = Tcl_FirstHashEntry(jtHashPtr, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { | | | 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 | Tcl_HashSearch search; /* Hash search control */ Tcl_HashEntry* entry; /* Hash table entry containing a jump label */ Tcl_Obj* label; /* Jump label from the hash table */ for (entry = Tcl_FirstHashEntry(jtHashPtr, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { label = (Tcl_Obj*)Tcl_GetHashValue(entry); Tcl_DecrRefCount(label); Tcl_SetHashValue(entry, NULL); } Tcl_DeleteHashTable(jtHashPtr); ckfree(jtPtr); } |
︙ | ︙ | |||
2654 2655 2656 2657 2658 2659 2660 | */ static BasicBlock * AllocBB( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; | | | 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 | */ static BasicBlock * AllocBB( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; BasicBlock *bb = (BasicBlock*)ckalloc(sizeof(BasicBlock)); bb->originalStartOffset = bb->startOffset = envPtr->codeNext - envPtr->codeStart; bb->startLine = assemEnvPtr->cmdLine + 1; bb->jumpOffset = -1; bb->jumpLine = -1; bb->prevPtr = assemEnvPtr->curr_bb; |
︙ | ︙ | |||
2845 2846 2847 2848 2849 2850 2851 | } /* * If the instruction is a JUMP1, turn it into a JUMP4 if its * target is out of range. */ | | | 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 | } /* * If the instruction is a JUMP1, turn it into a JUMP4 if its * target is out of range. */ jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); if (bbPtr->flags & BB_JUMP1) { offset = jumpTarget->startOffset - (bbPtr->jumpOffset + motion); if (offset < -0x80 || offset > 0x7f) { opcode = TclGetUInt1AtPtr(envPtr->codeStart + bbPtr->jumpOffset); ++opcode; |
︙ | ︙ | |||
2912 2913 2914 2915 2916 2917 2918 | * Look up every jump target in the jump hash. */ DEBUG_PRINT("check jump table labels %p {\n", bbPtr); for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { | | | 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 | * Look up every jump target in the jump hash. */ DEBUG_PRINT("check jump table labels %p {\n", bbPtr); for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr); valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(symbolObj)); DEBUG_PRINT(" %s -> %s (%d)\n", (char*) Tcl_GetHashKey(symHash, symEntryPtr), TclGetString(symbolObj), (valEntryPtr != NULL)); if (valEntryPtr == NULL) { ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj); |
︙ | ︙ | |||
3041 3042 3043 3044 3045 3046 3047 | for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr = bbPtr->successor1) { if (bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(bbPtr->jumpTarget)); | | | 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 | for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr = bbPtr->successor1) { if (bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(bbPtr->jumpTarget)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); fromOffset = bbPtr->jumpOffset; targetOffset = jumpTarget->startOffset; if (bbPtr->flags & BB_JUMP1) { TclStoreInt1AtPtr(targetOffset - fromOffset, envPtr->codeStart + fromOffset + 1); } else { TclStoreInt4AtPtr(targetOffset - fromOffset, |
︙ | ︙ | |||
3100 3101 3102 3103 3104 3105 3106 | BasicBlock* jumpTargetBBPtr; /* Basic block that the jump proceeds to */ int junk; auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); | | | | | 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 | BasicBlock* jumpTargetBBPtr; /* Basic block that the jump proceeds to */ int junk; auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); realJumpTablePtr = (JumptableInfo*)TclFetchAuxData(envPtr, auxDataIndex); realJumpHashPtr = &realJumpTablePtr->hashTable; /* * Look up every jump target in the jump hash. */ DEBUG_PRINT("resolve jump table {\n"); for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr); DEBUG_PRINT(" symbol %s\n", TclGetString(symbolObj)); valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(symbolObj)); jumpTargetBBPtr = (BasicBlock*)Tcl_GetHashValue(valEntryPtr); realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr, Tcl_GetHashKey(symHash, symEntryPtr), &junk); DEBUG_PRINT(" %s -> %s -> bb %p (pc %d) hash entry %p\n", (char*) Tcl_GetHashKey(symHash, symEntryPtr), TclGetString(symbolObj), jumpTargetBBPtr, jumpTargetBBPtr->startOffset, realJumpEntryPtr); |
︙ | ︙ | |||
3495 3496 3497 3498 3499 3500 3501 | result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1, blockPtr, stackDepth); } if (result == TCL_OK && blockPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(blockPtr->jumpTarget)); | | | | | 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 | result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1, blockPtr, stackDepth); } if (result == TCL_OK && blockPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(blockPtr->jumpTarget)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr, stackDepth); } /* * All blocks referenced in a jump table are successors. */ if (blockPtr->flags & BB_JUMPTABLE) { for (jtEntry = Tcl_FirstHashEntry(&blockPtr->jtPtr->hashTable, &jtSearch); result == TCL_OK && jtEntry != NULL; jtEntry = Tcl_NextHashEntry(&jtSearch)) { targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry); entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(targetLabel)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr, stackDepth); } } return result; } |
︙ | ︙ | |||
3817 3818 3819 3820 3821 3822 3823 | if (bbPtr->flags & BB_FALLTHRU) { result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1, fallThruEnclosing, fallThruState, catchDepth); } if (result == TCL_OK && bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(bbPtr->jumpTarget)); | | | | | 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 | if (bbPtr->flags & BB_FALLTHRU) { result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1, fallThruEnclosing, fallThruState, catchDepth); } if (result == TCL_OK && bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(bbPtr->jumpTarget)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, jumpEnclosing, jumpState, catchDepth); } /* * All blocks referenced in a jump table are successors. */ if (bbPtr->flags & BB_JUMPTABLE) { for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch); result == TCL_OK && jtEntry != NULL; jtEntry = Tcl_NextHashEntry(&jtSearch)) { targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry); entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(targetLabel)); jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, jumpEnclosing, jumpState, catchDepth); } } return result; } |
︙ | ︙ | |||
3932 3933 3934 3935 3936 3937 3938 | } } /* * Allocate memory for a stack of active catches. */ | | | | 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 | } } /* * Allocate memory for a stack of active catches. */ catches = (BasicBlock**)ckalloc(maxCatchDepth * sizeof(BasicBlock*)); catchIndices = (int *)ckalloc(maxCatchDepth * sizeof(int)); for (i = 0; i < maxCatchDepth; ++i) { catches[i] = NULL; catchIndices[i] = -1; } /* * Walk through the basic blocks and manage exception ranges. |
︙ | ︙ | |||
4001 4002 4003 4004 4005 4006 4007 | int catchDepth, /* Depth of nesting of catches prior to entry * to this block */ BasicBlock** catches, /* Array of catch contexts */ int* catchIndices) /* Indices of the exception ranges * corresponding to the catch contexts */ { ExceptionRange* range; /* Exception range for a specific catch */ | | | 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 | int catchDepth, /* Depth of nesting of catches prior to entry * to this block */ BasicBlock** catches, /* Array of catch contexts */ int* catchIndices) /* Indices of the exception ranges * corresponding to the catch contexts */ { ExceptionRange* range; /* Exception range for a specific catch */ BasicBlock* block; /* Catch block being examined */ BasicBlockCatchState catchState; /* State of the code relative to the catch * block being examined ("in catch" or * "caught"). */ /* * Unstack any catches that are deeper than the nesting level of the basic |
︙ | ︙ | |||
4029 4030 4031 4032 4033 4034 4035 | /* * Unstack any catches that don't match the basic block being entered, * either because they are no longer part of the context, or because the * context has changed from INCATCH to CAUGHT. */ catchState = bbPtr->catchState; | | | | | | 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 | /* * Unstack any catches that don't match the basic block being entered, * either because they are no longer part of the context, or because the * context has changed from INCATCH to CAUGHT. */ catchState = bbPtr->catchState; block = bbPtr->enclosingCatch; while (catchDepth > 0) { --catchDepth; if (catches[catchDepth] != NULL) { if (catches[catchDepth] != block || catchState >= BBCS_CAUGHT) { range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->numCodeBytes = bbPtr->startOffset - range->codeOffset; catches[catchDepth] = NULL; catchIndices[catchDepth] = -1; } catchState = block->catchState; block = block->enclosingCatch; } } } /* *----------------------------------------------------------------------------- * |
︙ | ︙ | |||
4069 4070 4071 4072 4073 4074 4075 | BasicBlock* bbPtr, /* Basic block being entered */ BasicBlock** catches) /* Array of catch contexts that are already * entered */ { BasicBlockCatchState catchState; /* State ("in catch" or "caught") of the * current catch. */ | | | | | | | | 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 | BasicBlock* bbPtr, /* Basic block being entered */ BasicBlock** catches) /* Array of catch contexts that are already * entered */ { BasicBlockCatchState catchState; /* State ("in catch" or "caught") of the * current catch. */ BasicBlock* block; /* Current enclosing catch */ int catchDepth; /* Nesting depth of the current catch */ catchState = bbPtr->catchState; block = bbPtr->enclosingCatch; catchDepth = bbPtr->catchDepth; while (catchDepth > 0) { --catchDepth; if (catches[catchDepth] != block && catchState < BBCS_CAUGHT) { catches[catchDepth] = block; } catchState = block->catchState; block = block->enclosingCatch; } } /* *----------------------------------------------------------------------------- * * StackFreshCatches -- |
︙ | ︙ | |||
4109 4110 4111 4112 4113 4114 4115 | BasicBlock** catches, /* Array of catch contexts */ int* catchIndices) /* Indices of the exception ranges * corresponding to the catch contexts */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ ExceptionRange* range; /* Exception range for a specific catch */ | | | | | | 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 | BasicBlock** catches, /* Array of catch contexts */ int* catchIndices) /* Indices of the exception ranges * corresponding to the catch contexts */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ ExceptionRange* range; /* Exception range for a specific catch */ BasicBlock* block; /* Catch block being examined */ BasicBlock* errorExit; /* Error exit from the catch block */ Tcl_HashEntry* entryPtr; catchDepth = 0; /* * Iterate through the enclosing catch blocks from the outside in, * looking for ones that don't have exception ranges (and are uncaught) */ for (catchDepth = 0; catchDepth < bbPtr->catchDepth; ++catchDepth) { if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) { /* * Create an exception range for a block that needs one. */ block = catches[catchDepth]; catchIndices[catchDepth] = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->nestingLevel = envPtr->exceptDepth + catchDepth; envPtr->maxExceptDepth = TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth); range->codeOffset = bbPtr->startOffset; entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(block->jumpTarget)); if (entryPtr == NULL) { Tcl_Panic("undefined label in tclAssembly.c:" "BuildExceptionRanges, can't happen"); } errorExit = (BasicBlock*)Tcl_GetHashValue(entryPtr); range->catchOffset = errorExit->startOffset; } } } /* *----------------------------------------------------------------------------- |
︙ | ︙ | |||
4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 | */ static void DupAssembleCodeInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { return; } /* *----------------------------------------------------------------------------- * * FreeAssembleCodeInternalRep -- | > > | 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 | */ static void DupAssembleCodeInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { (void)srcPtr; (void)copyPtr; return; } /* *----------------------------------------------------------------------------- * * FreeAssembleCodeInternalRep -- |
︙ | ︙ |
Changes to generic/tclAsync.c.
︙ | ︙ | |||
114 115 116 117 118 119 120 | Tcl_AsyncProc *proc, /* Procedure to call when handler is * invoked. */ ClientData clientData) /* Argument to pass to handler. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); | | | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | Tcl_AsyncProc *proc, /* Procedure to call when handler is * invoked. */ ClientData clientData) /* Argument to pass to handler. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); asyncPtr = (AsyncHandler*)ckalloc(sizeof(AsyncHandler)); asyncPtr->ready = 0; asyncPtr->nextPtr = NULL; asyncPtr->proc = proc; asyncPtr->clientData = clientData; asyncPtr->originTsd = tsdPtr; asyncPtr->originThrdId = Tcl_GetCurrentThread(); |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
29 30 31 32 33 34 35 36 37 | * 0 - fpclassify * 1 - _fpclass * 2 - simulate * 3 - __builtin_fpclassify */ #ifndef TCL_FPCLASSIFY_MODE /* * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify, | > | > < | | > > > | | | > > > > | | > > > > > | | | 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 | * 0 - fpclassify * 1 - _fpclass * 2 - simulate * 3 - __builtin_fpclassify */ #ifndef TCL_FPCLASSIFY_MODE #if defined(__MINGW32__) && defined(_X86_) /* mingw 32-bit */ /* * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify, * [fpclassify 1e-314], x86 => normal, x64 => subnormal, so switch to using a * version using a compiler built-in. */ #define TCL_FPCLASSIFY_MODE 1 #elif defined(fpclassify) /* fpclassify */ /* * This is the C99 standard. */ #include <float.h> #define TCL_FPCLASSIFY_MODE 0 #elif defined(_FPCLASS_NN) /* _fpclass */ /* * This case handles newer MSVC on Windows, which doesn't have the standard * operation but does have something that can tell us the same thing. */ #define TCL_FPCLASSIFY_MODE 1 #else /* !fpclassify && !_fpclass (older MSVC), simulate */ /* * Older MSVC on Windows. So broken that we just have to do it our way. This * assumes that we're on x86 (or at least a system with classic little-endian * double layout and a 32-bit 'int' type). */ #define TCL_FPCLASSIFY_MODE 2 #endif /* !fpclassify */ /* actually there is no fallback to builtin fpclassify */ #endif /* !TCL_FPCLASSIFY_MODE */ #define INTERP_STACK_INITIAL_SIZE 2000 #define CORO_STACK_INITIAL_SIZE 200 |
︙ | ︙ | |||
640 641 642 643 644 645 646 | */ if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) { /*NOTREACHED*/ Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } | | | < | < > > > > | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 | */ if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) { /*NOTREACHED*/ Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } #if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T * the result is a binary incompatible with the 'standard' build of * Tcl: All extensions using Tcl_StatBuf need to be recompiled in * the same way. Therefore, this is not officially supported. * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet) */ if ((offsetof(Tcl_StatBuf,st_atime) != 32) || (offsetof(Tcl_StatBuf,st_ctime) != 40)) { /*NOTREACHED*/ Tcl_Panic("<sys/stat.h> is not compatible with MSVC"); } #endif |
︙ | ︙ | |||
1280 1281 1282 1283 1284 1285 1286 | *---------------------------------------------------------------------- */ int TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { | | | | 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 | *---------------------------------------------------------------------- */ int TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { const CmdInfo *cmdInfoPtr; const UnsafeEnsembleInfo *unsafePtr; if (interp == NULL) { return TCL_ERROR; } for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) { Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); |
︙ | ︙ | |||
2618 2619 2620 2621 2622 2623 2624 | } Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace * components. */ | | | | 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 | } Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace * components. */ Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ ClientData clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { int deleted = 0, isNew = 0; Command *cmdPtr; ImportRef *oldRefPtr = NULL; ImportedCmdData *dataPtr; Tcl_HashEntry *hPtr; Namespace *nsPtr = (Namespace *) namesp; /* * If the command name we seek to create already exists, we need to delete * that first. That can be tricky in the presence of traces. Loop until we * no longer find an existing command in the way, or until we've deleted * one command and that didn't finish the job. */ |
︙ | ︙ | |||
2807 2808 2809 2810 2811 2812 2813 | *---------------------------------------------------------------------- */ int TclInvokeStringCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ | | | 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 | *---------------------------------------------------------------------- */ int TclInvokeStringCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr = clientData; int i, result; const char **argv = TclStackAlloc(interp, (objc + 1) * sizeof(char *)); |
︙ | ︙ | |||
2856 2857 2858 2859 2860 2861 2862 | */ int TclInvokeObjectCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ | | | 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 | */ int TclInvokeObjectCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Command *cmdPtr = clientData; Tcl_Obj *objPtr; int i, length, result; Tcl_Obj **objv = TclStackAlloc(interp, (argc * sizeof(Tcl_Obj *))); |
︙ | ︙ | |||
3347 3348 3349 3350 3351 3352 3353 | * call to Tcl_CreateCommand. The command must * not have been deleted. */ Tcl_Obj *objPtr) /* Points to the object onto which the * command's full name is appended. */ { Interp *iPtr = (Interp *) interp; | | | 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 | * call to Tcl_CreateCommand. The command must * not have been deleted. */ Tcl_Obj *objPtr) /* Points to the object onto which the * command's full name is appended. */ { Interp *iPtr = (Interp *) interp; Command *cmdPtr = (Command *) command; char *name; /* * Add the full name of the containing namespace, followed by the "::" * separator, and the command name. */ |
︙ | ︙ | |||
3631 3632 3633 3634 3635 3636 3637 | * the name from cmdPtr */ const char *newName, /* Command's new name, or NULL if the command * is not being renamed */ int flags) /* Flags indicating the type of traces to * trigger, either TCL_TRACE_DELETE or * TCL_TRACE_RENAME. */ { | | | 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 | * the name from cmdPtr */ const char *newName, /* Command's new name, or NULL if the command * is not being renamed */ int flags) /* Flags indicating the type of traces to * trigger, either TCL_TRACE_DELETE or * TCL_TRACE_RENAME. */ { CommandTrace *tracePtr; ActiveCommandTrace active; char *result; Tcl_Obj *oldNamePtr = NULL; Tcl_InterpState state = NULL; if (cmdPtr->flags & CMD_TRACE_ACTIVE) { /* |
︙ | ︙ | |||
3821 3822 3823 3824 3825 3826 3827 | * deleted or when the last ByteCode referring to it is freed. * *---------------------------------------------------------------------- */ void TclCleanupCommand( | | | 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 | * deleted or when the last ByteCode referring to it is freed. * *---------------------------------------------------------------------- */ void TclCleanupCommand( Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { ckfree(cmdPtr); } } |
︙ | ︙ | |||
4212 4213 4214 4215 4216 4217 4218 | *---------------------------------------------------------------------- */ int TclInterpReady( Tcl_Interp *interp) { | | | 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 | *---------------------------------------------------------------------- */ int TclInterpReady( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; /* * Reset both the interpreter's string and object results and clear out * any previous error information. */ Tcl_ResetResult(interp); |
︙ | ︙ | |||
4284 4285 4286 4287 4288 4289 4290 | */ int TclResetCancellation( Tcl_Interp *interp, int force) { | | | 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 | */ int TclResetCancellation( Tcl_Interp *interp, int force) { Interp *iPtr = (Interp *) interp; if (iPtr == NULL) { return TCL_ERROR; } if (force || (iPtr->numLevels == 0)) { TclUnsetCancelFlags(iPtr); |
︙ | ︙ | |||
4326 4327 4328 4329 4330 4331 4332 | */ int Tcl_Canceled( Tcl_Interp *interp, int flags) { | | | 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 | */ int Tcl_Canceled( Tcl_Interp *interp, int flags) { Interp *iPtr = (Interp *) interp; /* * Has the current script in progress for this interpreter been canceled * or is the stack being unwound due to the previous script cancellation? */ if (!TclCanceled(iPtr)) { |
︙ | ︙ | |||
5847 5848 5849 5850 5851 5852 5853 | void TclAdvanceLines( int *line, const char *start, const char *end) { | | | 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 | void TclAdvanceLines( int *line, const char *start, const char *end) { const char *p; for (p = start; p < end; p++) { if (*p == '\n') { (*line)++; } } } |
︙ | ︙ | |||
5942 5943 5944 5945 5946 5947 5948 | TclArgumentEnter( Tcl_Interp *interp, Tcl_Obj **objv, int objc, CmdFrame *cfPtr) { Interp *iPtr = (Interp *) interp; | | | | | 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 | TclArgumentEnter( Tcl_Interp *interp, Tcl_Obj **objv, int objc, CmdFrame *cfPtr) { Interp *iPtr = (Interp *) interp; int isNew, i; Tcl_HashEntry *hPtr; CFWord *cfwPtr; for (i = 1; i < objc; i++) { /* * Ignore argument words without line information (= dynamic). If they * are variables they may have location information associated with * that, either through globally recorded 'set' invokations, or * literals in bytecode. Eitehr way there is no need to record * something here. */ if (cfPtr->line[i] < 0) { continue; } hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew); if (isNew) { /* * The word is not on the stack yet, remember the current location * and initialize references. */ cfwPtr = ckalloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; |
︙ | ︙ | |||
6373 6374 6375 6376 6377 6378 6379 | *---------------------------------------------------------------------- */ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ | | | | | 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 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 | *---------------------------------------------------------------------- */ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { return TclEvalObjEx(interp, objPtr, flags, NULL, 0); } int TclEvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ int word) /* Index of the word which is in objPtr. */ { int result = TCL_OK; NRE_callback *rootPtr = TOP_CB(interp); result = TclNREvalObjEx(interp, objPtr, flags, invoker, word); return TclNRRunCallbacks(interp, result, rootPtr); } int TclNREvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ int word) /* Index of the word which is in objPtr. */ { |
︙ | ︙ | |||
6713 6714 6715 6716 6717 6718 6719 | int Tcl_ExprLong( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ long *ptr) /* Where to store result. */ { | | | 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 | int Tcl_ExprLong( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ long *ptr) /* Where to store result. */ { Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0; |
︙ | ︙ | |||
6740 6741 6742 6743 6744 6745 6746 | int Tcl_ExprDouble( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ double *ptr) /* Where to store result. */ { | | | 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 | int Tcl_ExprDouble( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ double *ptr) /* Where to store result. */ { Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ |
︙ | ︙ | |||
6820 6821 6822 6823 6824 6825 6826 | *-------------------------------------------------------------- */ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 6849 | *-------------------------------------------------------------- */ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; int result, type; double d; ClientData internalPtr; |
︙ | ︙ | |||
6847 6848 6849 6850 6851 6852 6853 | d = *((const double *) internalPtr); Tcl_DecrRefCount(resultPtr); if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewBignumObj(&big); | < > | | 6862 6863 6864 6865 6866 6867 6868 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 | d = *((const double *) internalPtr); Tcl_DecrRefCount(resultPtr); if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewBignumObj(&big); } /* FALLTHRU */ case TCL_NUMBER_INT: case TCL_NUMBER_BIG: result = TclGetLongFromObj(interp, resultPtr, ptr); break; case TCL_NUMBER_NAN: Tcl_GetDoubleFromObj(interp, resultPtr, &d); result = TCL_ERROR; } Tcl_DecrRefCount(resultPtr);/* Discard the result object. */ return result; } int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; int result, type; ClientData internalPtr; result = Tcl_ExprObj(interp, objPtr, &resultPtr); |
︙ | ︙ | |||
6903 6904 6905 6906 6907 6908 6909 | return result; } int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 6932 | return result; } int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ int *ptr) /* Where to store 0/1 result. */ { Tcl_Obj *resultPtr; int result; result = Tcl_ExprObj(interp, objPtr, &resultPtr); if (result == TCL_OK) { |
︙ | ︙ | |||
7015 7016 7017 7018 7019 7020 7021 | int TclNRInvoke( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { | | | 7030 7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 | int TclNRInvoke( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ const char *cmdName; /* Name of the command from objv[0]. */ Tcl_HashEntry *hPtr = NULL; Command *cmdPtr; cmdName = TclGetString(objv[0]); hTblPtr = iPtr->hiddenCmdTablePtr; |
︙ | ︙ | |||
7210 7211 7212 7213 7214 7215 7216 | Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ const char *message, /* Points to the first byte of an array of * bytes of the message. */ int length) /* The number of bytes in the message. If < 0, * then append all bytes up to a NULL byte. */ { | | | 7225 7226 7227 7228 7229 7230 7231 7232 7233 7234 7235 7236 7237 7238 7239 | Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ const char *message, /* Points to the first byte of an array of * bytes of the message. */ int length) /* The number of bytes in the message. If < 0, * then append all bytes up to a NULL byte. */ { Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from * the error message in the interpreter's result. */ iPtr->flags |= ERR_LEGACY_COPY; |
︙ | ︙ | |||
7360 7361 7362 7363 7364 7365 7366 | #undef Tcl_GlobalEval int Tcl_GlobalEval( Tcl_Interp *interp, /* Interpreter in which to evaluate * command. */ const char *command) /* Command to evaluate. */ { | | | 7375 7376 7377 7378 7379 7380 7381 7382 7383 7384 7385 7386 7387 7388 7389 | #undef Tcl_GlobalEval int Tcl_GlobalEval( Tcl_Interp *interp, /* Interpreter in which to evaluate * command. */ const char *command) /* Command to evaluate. */ { Interp *iPtr = (Interp *) interp; int result; CallFrame *savedVarFramePtr; savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; result = Tcl_EvalEx(interp, command, -1, 0); iPtr->varFramePtr = savedVarFramePtr; |
︙ | ︙ | |||
8362 8363 8364 8365 8366 8367 8368 | static inline int ClassifyDouble( double d) { #if TCL_FPCLASSIFY_MODE == 0 return fpclassify(d); | | | | | > | | | 8377 8378 8379 8380 8381 8382 8383 8384 8385 8386 8387 8388 8389 8390 8391 8392 8393 8394 8395 8396 8397 8398 8399 8400 8401 8402 8403 8404 8405 8406 8407 | static inline int ClassifyDouble( double d) { #if TCL_FPCLASSIFY_MODE == 0 return fpclassify(d); #else /* TCL_FPCLASSIFY_MODE != 0 */ /* * If we don't have fpclassify(), we also don't have the values it returns. * Hence we define those here. */ #ifndef FP_NAN # define FP_NAN 1 /* Value is NaN */ # define FP_INFINITE 2 /* Value is an infinity */ # define FP_ZERO 3 /* Value is a zero */ # define FP_NORMAL 4 /* Value is a normal float */ # define FP_SUBNORMAL 5 /* Value has lost accuracy */ #endif /* !FP_NAN */ #if TCL_FPCLASSIFY_MODE == 3 return __builtin_fpclassify( FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); #elif TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. * Specifically, x86 running Windows. It's fairly easy to enable for * others if they need it (because their libc/libm is broken) but we'll * jump that hurdle when requred. We can solve the word ordering then. */ |
︙ | ︙ | |||
8404 8405 8406 8407 8408 8409 8410 | /* The pieces extracted from the double. */ int zeroMantissa; /* Was the mantissa zero? That's special. */ /* * Shifts and masks to use with the doubleMeaning variable above. */ | | | | | 8420 8421 8422 8423 8424 8425 8426 8427 8428 8429 8430 8431 8432 8433 8434 8435 8436 | /* The pieces extracted from the double. */ int zeroMantissa; /* Was the mantissa zero? That's special. */ /* * Shifts and masks to use with the doubleMeaning variable above. */ #define EXPONENT_MASK 0x7ff /* 11 bits (after shifting) */ #define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ #define MANTISSA_MASK 0xfffff /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we * totally ignore the sign bit. */ doubleMeaning.d = d; |
︙ | ︙ | |||
8443 8444 8445 8446 8447 8448 8449 | default: /* * Everything else is a NORMAL double precision float. */ return FP_NORMAL; } | | | | | | 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 | default: /* * Everything else is a NORMAL double precision float. */ return FP_NORMAL; } #elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: return FP_ZERO; case _FPCLASS_NN: case _FPCLASS_PN: return FP_NORMAL; case _FPCLASS_ND: case _FPCLASS_PD: return FP_SUBNORMAL; case _FPCLASS_NINF: case _FPCLASS_PINF: return FP_INFINITE; default: Tcl_Panic("result of _fpclass() outside documented range!"); case _FPCLASS_QNAN: case _FPCLASS_SNAN: return FP_NAN; } #else /* TCL_FPCLASSIFY_MODE not in (0..3) */ #error "unknown or unexpected TCL_FPCLASSIFY_MODE" #endif /* TCL_FPCLASSIFY_MODE */ #endif /* !fpclassify */ } static int ExprIsFiniteFunc( ClientData ignored, Tcl_Interp *interp, /* The interpreter in which to execute the |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
2284 2285 2286 2287 2288 2289 2290 | value -= (((unsigned) 1) << 31); } returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewWideIntObj(value); } else { | | | | | 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 | value -= (((unsigned) 1) << 31); } returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewWideIntObj(value); } else { Tcl_HashTable *tablePtr = *numberCachePtrPtr; Tcl_HashEntry *hPtr; int isNew; hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew); if (!isNew) { return Tcl_GetHashValue(hPtr); } if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) { Tcl_Obj *objPtr = Tcl_NewWideIntObj(value); Tcl_IncrRefCount(objPtr); Tcl_SetHashValue(hPtr, objPtr); return objPtr; } /* |
︙ | ︙ | |||
2412 2413 2414 2415 2416 2417 2418 | if (numberCachePtr == NULL) { return; } hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { | | | 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 | if (numberCachePtr == NULL) { return; } hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { Tcl_Obj *value = Tcl_GetHashValue(hEntry); if (value != NULL) { Tcl_DecrRefCount(value); } hEntry = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(numberCachePtr); |
︙ | ︙ |
Changes to generic/tclCkalloc.c.
︙ | ︙ | |||
1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 | char * Tcl_AttemptDbCkalloc( unsigned int size, const char *file, int line) { char *result; result = (char *) TclpAlloc(size); return result; } /* *---------------------------------------------------------------------- | > > | 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 | char * Tcl_AttemptDbCkalloc( unsigned int size, const char *file, int line) { char *result; (void)file; (void)line; result = (char *) TclpAlloc(size); return result; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 | Tcl_AttemptDbCkrealloc( char *ptr, unsigned int size, const char *file, int line) { char *result; result = (char *) TclpRealloc(ptr, size); return result; } /* *---------------------------------------------------------------------- | > > | 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 | Tcl_AttemptDbCkrealloc( char *ptr, unsigned int size, const char *file, int line) { char *result; (void)file; (void)line; result = (char *) TclpRealloc(ptr, size); return result; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 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 1277 1278 | void Tcl_DbCkfree( char *ptr, const char *file, int line) { TclpFree(ptr); } /* *---------------------------------------------------------------------- * * Tcl_InitMemory -- * * Dummy initialization for memory command, which is only available if * TCL_MEM_DEBUG is on. * *---------------------------------------------------------------------- */ /* ARGSUSED */ void Tcl_InitMemory( Tcl_Interp *interp) { } int Tcl_DumpActiveMemory( const char *fileName) { return TCL_OK; } void Tcl_ValidateAllMemory( const char *file, int line) { } int TclDumpMemoryInfo( ClientData clientData, int flags) { return 1; } #endif /* TCL_MEM_DEBUG */ /* *--------------------------------------------------------------------------- | > > > > > > > > | 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 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 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 | void Tcl_DbCkfree( char *ptr, const char *file, int line) { (void)file; (void)line; TclpFree(ptr); } /* *---------------------------------------------------------------------- * * Tcl_InitMemory -- * * Dummy initialization for memory command, which is only available if * TCL_MEM_DEBUG is on. * *---------------------------------------------------------------------- */ /* ARGSUSED */ void Tcl_InitMemory( Tcl_Interp *interp) { (void)interp; } int Tcl_DumpActiveMemory( const char *fileName) { (void)fileName; return TCL_OK; } void Tcl_ValidateAllMemory( const char *file, int line) { (void)file; (void)line; } int TclDumpMemoryInfo( ClientData clientData, int flags) { (void)clientData; (void)flags; return 1; } #endif /* TCL_MEM_DEBUG */ /* *--------------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclClock.c.
︙ | ︙ | |||
1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 | ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *varName; const char *varValue; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } varName = TclGetString(objv[1]); varValue = getenv(varName); | > | 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 | ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *varName; const char *varValue; (void)clientData; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } varName = TclGetString(objv[1]); varValue = getenv(varName); |
︙ | ︙ | |||
1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 | }; enum ClicksSwitch { CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE }; int index = CLICKS_NATIVE; Tcl_Time now; Tcl_WideInt clicks = 0; switch (objc) { case 1: break; case 2: if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0, &index) != TCL_OK) { | > | 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 | }; enum ClicksSwitch { CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE }; int index = CLICKS_NATIVE; Tcl_Time now; Tcl_WideInt clicks = 0; (void)clientData; switch (objc) { case 1: break; case 2: if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0, &index) != TCL_OK) { |
︙ | ︙ | |||
1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 | ClockMillisecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) | > | 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 | ClockMillisecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) |
︙ | ︙ | |||
1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 | int ClockMicrosecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); return TCL_OK; } | > | 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 | int ClockMicrosecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); return TCL_OK; } |
︙ | ︙ | |||
1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 | ClockSecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec)); | > | 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 | ClockSecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec)); |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
11 12 13 14 15 16 17 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef _WIN32 # include "tclWinInt.h" #endif | < | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef _WIN32 # include "tclWinInt.h" #endif /* * The state structure used by [foreach]. Note that the actual structure has * all its working arrays appended afterwards so they can be allocated and * freed in a single step. */ |
︙ | ︙ | |||
165 166 167 168 169 170 171 | int Tcl_CaseObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | int Tcl_CaseObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i; int body, result, caseObjc; const char *stringPtr, *arg; Tcl_Obj *const *caseObjv; Tcl_Obj *armPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, |
︙ | ︙ | |||
868 869 870 871 872 873 874 | int TclNREvalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 | int TclNREvalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *objPtr; Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); return TCL_ERROR; |
︙ | ︙ | |||
1135 1136 1137 1138 1139 1140 1141 | return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the access time not available */ | | | | | 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 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 | return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the access time not available */ if (Tcl_GetAccessTimeFromStat(&buf) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not get access time for file \"%s\"", TclGetString(objv[1]))); return TCL_ERROR; } #endif if (objc == 3) { /* * Need separate variable for reading longs from an object on 64-bit * platforms. [Bug 698146] */ Tcl_WideInt newTime; if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) { return TCL_ERROR; } tval.actime = newTime; tval.modtime = Tcl_GetModificationTimeFromStat(&buf); if (Tcl_FSUtime(objv[1], &tval) != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set access time for file \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } /* * Do another stat to ensure that the we return the new recognized * atime - hopefully the same as the one we sent in. However, fs's * like FAT don't even know what atime is. */ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(&buf))); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrModifyTimeCmd -- |
︙ | ︙ | |||
1217 1218 1219 1220 1221 1222 1223 | return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the modification time not available */ | | | | | 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 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 | return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the modification time not available */ if (Tcl_GetModificationTimeFromStat(&buf) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not get modification time for file \"%s\"", TclGetString(objv[1]))); return TCL_ERROR; } #endif if (objc == 3) { /* * Need separate variable for reading longs from an object on 64-bit * platforms. [Bug 698146] */ Tcl_WideInt newTime; if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) { return TCL_ERROR; } tval.actime = Tcl_GetAccessTimeFromStat(&buf); tval.modtime = newTime; if (Tcl_FSUtime(objv[1], &tval) != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set modification time for file \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } /* * Do another stat to ensure that the we return the new recognized * mtime - hopefully the same as the one we sent in. */ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(&buf))); return TCL_OK; } /* *---------------------------------------------------------------------- * * FileAttrLinkStatCmd -- |
︙ | ︙ | |||
2250 2251 2252 2253 2254 2255 2256 | Tcl_Interp *interp, /* Interpreter for error reports. */ Tcl_Obj *varName, /* Name of associative array variable in which * to store stat results. */ Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to * store in varName. */ { Tcl_Obj *field, *value; | | | 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 | Tcl_Interp *interp, /* Interpreter for error reports. */ Tcl_Obj *varName, /* Name of associative array variable in which * to store stat results. */ Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to * store in varName. */ { Tcl_Obj *field, *value; unsigned short mode; /* * Assume Tcl_ObjSetVar2() does not keep a copy of the field name! * * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want * to have an object (i.e. possibly cached) array variable name but a * string element name, so no API exists. Messy. |
︙ | ︙ | |||
2287 2288 2289 2290 2291 2292 2293 | STORE_ARY("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); #ifdef HAVE_STRUCT_STAT_ST_BLOCKS STORE_ARY("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks)); #endif #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize)); #endif | | | | | 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 | STORE_ARY("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); #ifdef HAVE_STRUCT_STAT_ST_BLOCKS STORE_ARY("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks)); #endif #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize)); #endif STORE_ARY("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); STORE_ARY("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); STORE_ARY("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); mode = (unsigned short) statPtr->st_mode; STORE_ARY("mode", Tcl_NewWideIntObj(mode)); STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); #undef STORE_ARY return TCL_OK; } |
︙ | ︙ | |||
2627 2628 2629 2630 2631 2632 2633 | * evaluation. */ int collect, /* Select collecting or accumulating mode * (TCL_EACH_*) */ int objc, /* The arguments being passed in... */ Tcl_Obj *const objv[]) { int numLists = (objc-2) / 2; | | | 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 | * evaluation. */ int collect, /* Select collecting or accumulating mode * (TCL_EACH_*) */ int objc, /* The arguments being passed in... */ Tcl_Obj *const objv[]) { int numLists = (objc-2) / 2; struct ForeachState *statePtr; int i, j, result; if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, "varList list ?varList list ...? command"); return TCL_ERROR; } |
︙ | ︙ | |||
2752 2753 2754 2755 2756 2757 2758 | static int ForeachLoopStep( ClientData data[], Tcl_Interp *interp, int result) { | | | 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 | static int ForeachLoopStep( ClientData data[], Tcl_Interp *interp, int result) { struct ForeachState *statePtr = data[0]; /* * Process the result code from this run of the [foreach] body. Note that * this switch uses fallthroughs in several places. Maintainer aware! */ switch (result) { |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
471 472 473 474 475 476 477 | static int InfoArgsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 | static int InfoArgsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *name; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *listObjPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); |
︙ | ︙ | |||
534 535 536 537 538 539 540 | static int InfoBodyCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 | static int InfoBodyCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; int numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); return TCL_ERROR; |
︙ | ︙ | |||
639 640 641 642 643 644 645 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *cmdName, *pattern; const char *simplePattern; | | | 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *cmdName, *pattern; const char *simplePattern; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; |
︙ | ︙ | |||
1839 1840 1841 1842 1843 1844 1845 | Namespace *nsPtr; #ifdef INFO_PROCS_SEARCH_GLOBAL_NS Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); #endif Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ | | | 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 | Namespace *nsPtr; #ifdef INFO_PROCS_SEARCH_GLOBAL_NS Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); #endif Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr, *realCmdPtr; /* * Get the pattern and find the "effective namespace" in which to list * procs. */ |
︙ | ︙ | |||
1954 1955 1956 1957 1958 1959 1960 | * namespace. */ #ifdef INFO_PROCS_SEARCH_GLOBAL_NS /* * If "info procs" worked like "info commands", returning the commands * also seen in the global namespace, then you would include this | | | 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 | * namespace. */ #ifdef INFO_PROCS_SEARCH_GLOBAL_NS /* * If "info procs" worked like "info commands", returning the commands * also seen in the global namespace, then you would include this * code. As this could break backwards compatibility with 8.0-8.2, we * decided not to "fix" it in 8.3, leaving the behavior slightly * different. */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { |
︙ | ︙ | |||
2411 2412 2413 2414 2415 2416 2417 | *---------------------------------------------------------------------- */ int Tcl_LinsertObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 | *---------------------------------------------------------------------- */ int Tcl_LinsertObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; int index, len, result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); |
︙ | ︙ | |||
2493 2494 2495 2496 2497 2498 2499 | *---------------------------------------------------------------------- */ int Tcl_ListObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | | 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 | *---------------------------------------------------------------------- */ int Tcl_ListObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { /* * If there are no list elements, the result is an empty object. * Otherwise set the interpreter's result object to be a list object. */ |
︙ | ︙ | |||
2530 2531 2532 2533 2534 2535 2536 | */ int Tcl_LlengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 | */ int Tcl_LlengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; |
︙ | ︙ | |||
2576 2577 2578 2579 2580 2581 2582 | */ int Tcl_LpopObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 | */ int Tcl_LpopObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; Tcl_Obj *elemPtr, *stored; Tcl_Obj *listPtr, **elemPtrs; if (objc < 2) { |
︙ | ︙ | |||
2669 2670 2671 2672 2673 2674 2675 | */ int Tcl_LrangeObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 | */ int Tcl_LrangeObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, first, last, result; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; |
︙ | ︙ | |||
2855 2856 2857 2858 2859 2860 2861 | *---------------------------------------------------------------------- */ int Tcl_LrepeatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | | 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 | *---------------------------------------------------------------------- */ int Tcl_LrepeatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int elementCount, i, totalElems; Tcl_Obj *listPtr, **dataArray = NULL; /* * Check arguments for legality: |
︙ | ︙ | |||
2921 2922 2923 2924 2925 2926 2927 | * single value being repeated separately to permit the compiler as much * room as possible to optimize a loop that might be run a very large * number of times. */ CLANG_ASSERT(dataArray || totalElems == 0 ); if (objc == 1) { | | | 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 | * single value being repeated separately to permit the compiler as much * room as possible to optimize a loop that might be run a very large * number of times. */ CLANG_ASSERT(dataArray || totalElems == 0 ); if (objc == 1) { Tcl_Obj *tmpPtr = objv[0]; tmpPtr->refCount += elementCount; for (i=0 ; i<elementCount ; i++) { dataArray[i] = tmpPtr; } } else { int j, k = 0; |
︙ | ︙ | |||
2967 2968 2969 2970 2971 2972 2973 | int Tcl_LreplaceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 | int Tcl_LreplaceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; int first, last, listLen, numToDelete, result; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last ?element ...?"); return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
1658 1659 1660 1661 1662 1663 1664 | * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetDictFromAny(). */ const char *elemStart, *nextElem; int lenRemain, elemSize; | | | 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 | * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetDictFromAny(). */ const char *elemStart, *nextElem; int lenRemain, elemSize; const char *p; string1 = TclGetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { if (TCL_ERROR == TclFindElement(NULL, p, lenRemain, |
︙ | ︙ | |||
1838 1839 1840 1841 1842 1843 1844 | * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; int lenRemain, elemSize; | | | 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 | * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; int lenRemain, elemSize; const char *p; string1 = TclGetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { if (TCL_ERROR == TclFindElement(NULL, p, lenRemain, |
︙ | ︙ | |||
4056 4057 4058 4059 4060 4061 4062 | int Tcl_TimeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 | int Tcl_TimeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *objPtr; Tcl_Obj *objs[4]; int i, result; int count; double totalMicroSec; #ifndef TCL_WIDE_CLICKS Tcl_Time start, stop; #else Tcl_WideInt start, stop; #endif |
︙ | ︙ | |||
4157 4158 4159 4160 4161 4162 4163 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static double measureOverhead = 0; /* global measure-overhead */ double overhead = -1; /* given measure-overhead */ | | | | < | 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static double measureOverhead = 0; /* global measure-overhead */ double overhead = -1; /* given measure-overhead */ Tcl_Obj *objPtr; int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; TclWideMUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ TclWideMUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ TclWideMUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max * threshold, additionally avoiding divide to * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid * growth of execution time. */ Tcl_WideInt start, middle, stop; #ifndef TCL_WIDE_CLICKS Tcl_Time now; #endif /* !TCL_WIDE_CLICKS */ static const char *const options[] = { "-direct", "-overhead", "-calibrate", "--", NULL }; enum options { TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST }; NRE_callback *rootPtr; ByteCode *codePtr = NULL; for (i = 1; i < objc - 1; i++) { int index; if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { break; |
︙ | ︙ | |||
4369 4370 4371 4372 4373 4374 4375 | if (!direct) { if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); | < < < < < < < < < | 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 | if (!direct) { if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); } /* * Get start and stop time. */ #ifdef TCL_WIDE_CLICKS |
︙ | ︙ | |||
4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 | /* * Evaluate a single iteration. */ count++; if (!direct) { /* precompiled */ rootPtr = TOP_CB(interp); result = TclNRExecuteByteCode(interp, codePtr); result = TclNRRunCallbacks(interp, result, rootPtr); } else { /* eval */ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); } /* * Allow break and continue from measurement cycle (used for * conditional stop and flow control of iterations). */ switch (result) { case TCL_OK: break; case TCL_BREAK: /* * Force stop immediately. */ threshold = 1; maxcnt = 0; case TCL_CONTINUE: result = TCL_OK; break; default: goto done; } | > > > > > > > | 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 | /* * Evaluate a single iteration. */ count++; if (!direct) { /* precompiled */ rootPtr = TOP_CB(interp); /* * Use loop optimized TEBC call (TCL_EVAL_DISCARD_RESULT): it's a part of * iteration, this way evaluation will be more similar to a cycle (also * avoids extra overhead to set result to interp, etc.) */ ((Interp *)interp)->evalFlags |= TCL_EVAL_DISCARD_RESULT; result = TclNRExecuteByteCode(interp, codePtr); result = TclNRRunCallbacks(interp, result, rootPtr); } else { /* eval */ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); } /* * Allow break and continue from measurement cycle (used for * conditional stop and flow control of iterations). */ switch (result) { case TCL_OK: break; case TCL_BREAK: /* * Force stop immediately. */ threshold = 1; maxcnt = 0; /* FALLTHRU */ case TCL_CONTINUE: result = TCL_OK; break; default: goto done; } |
︙ | ︙ | |||
4671 4672 4673 4674 4675 4676 4677 | TclNewLiteralStringObj(objs[3], "#"); TclNewLiteralStringObj(objs[5], "#/sec"); Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr)); } done: if (codePtr != NULL) { | < < < < < | 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 | TclNewLiteralStringObj(objs[3], "#"); TclNewLiteralStringObj(objs[5], "#/sec"); Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr)); } done: if (codePtr != NULL) { TclReleaseByteCode(codePtr); } return result; } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclCompCmds.c.
︙ | ︙ | |||
2908 2909 2910 2911 2912 2913 2914 | */ static ClientData DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { | | | | 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 | */ static ClientData DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { ForeachInfo *srcPtr = clientData; ForeachInfo *dupPtr; ForeachVarList *srcListPtr, *dupListPtr; int numVars, i, j, numLists = srcPtr->numLists; dupPtr = ckalloc(sizeof(ForeachInfo) + numLists * sizeof(ForeachVarList *)); dupPtr->numLists = numLists; dupPtr->firstValueTemp = srcPtr->firstValueTemp; dupPtr->loopCtTemp = srcPtr->loopCtTemp; |
︙ | ︙ | |||
2957 2958 2959 2960 2961 2962 2963 | */ static void FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { | | | | | 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 | */ static void FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { ForeachInfo *infoPtr = clientData; ForeachVarList *listPtr; int numLists = infoPtr->numLists; int i; for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; ckfree(listPtr); } ckfree(infoPtr); } |
︙ | ︙ | |||
2993 2994 2995 2996 2997 2998 2999 | static void PrintForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { | | | | 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 | static void PrintForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = clientData; ForeachVarList *varsPtr; int i, j; Tcl_AppendToObj(appendObj, "data=[", -1); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ", ", -1); |
︙ | ︙ | |||
3033 3034 3035 3036 3037 3038 3039 | static void PrintNewForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { | | | | 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 | static void PrintNewForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = clientData; ForeachVarList *varsPtr; int i, j; Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=", infoPtr->loopCtTemp); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ",", -1); |
︙ | ︙ | |||
3063 3064 3065 3066 3067 3068 3069 | static void DisassembleForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { | | | | 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 | static void DisassembleForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = clientData; ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; /* * Data stores. */ |
︙ | ︙ | |||
3110 3111 3112 3113 3114 3115 3116 | static void DisassembleNewForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { | | | | 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 | static void DisassembleNewForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = clientData; ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; /* * Jump offset. */ |
︙ | ︙ | |||
3170 3171 3172 3173 3174 3175 3176 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Obj **objv, *formatObj, *tmpObj; | | | 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Obj **objv, *formatObj, *tmpObj; const char *bytes, *start; int i, j, len; /* * Don't handle any guaranteed-error cases. */ if (parsePtr->numWords < 2) { |
︙ | ︙ | |||
3297 3298 3299 3300 3301 3302 3303 | * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { | | | 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 | * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { const char *b = TclGetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, * push it and reset. */ if (len > 0) { |
︙ | ︙ | |||
3435 3436 3437 3438 3439 3440 3441 | Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ int *localIndexPtr, /* Must not be NULL. */ int *isScalarPtr) /* Must not be NULL. */ { | | | | 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 | Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ int *localIndexPtr, /* Must not be NULL. */ int *isScalarPtr) /* Must not be NULL. */ { const char *p; const char *last, *name, *elName; int n; Tcl_Token *elemTokenPtr = NULL; int nameLen, elNameLen, simpleVarName, localIndex; int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; /* * Decide if we can use a frame slot for the var/array name or if we need * to emit code to compute and push the name at runtime. We use a frame |
︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
︙ | ︙ | |||
585 586 587 588 589 590 591 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; | | | 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; const char *bytes; /* * We require one compile-time known argument for the case we can compile. */ if (parsePtr->numWords == 1) { return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr); |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
︙ | ︙ | |||
921 922 923 924 925 926 927 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; | | | 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; const char *bytes; int len; /* * We only handle the case: * * string map {foo bar} $thing * |
︙ | ︙ | |||
1858 1859 1860 1861 1862 1863 1864 | * way to statically avoid the problems you get from strings-to-be-matched * that start with a - (the interpreted code falls apart if it encounters * them, so we punt if we *might* encounter them as that is the easiest * way of emulating the behaviour). */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { | | | | 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 | * way to statically avoid the problems you get from strings-to-be-matched * that start with a - (the interpreted code falls apart if it encounters * them, so we punt if we *might* encounter them as that is the easiest * way of emulating the behaviour). */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { unsigned size = tokenPtr[1].size; const char *chrs = tokenPtr[1].start; /* * We only process literal options, and we assume that -e, -g and -n * are unique prefixes of -exact, -glob and -nocase respectively (true * at time of writing). Note that -exact and -glob may only be given * at most once or we bail out (error case). */ |
︙ | ︙ | |||
2598 2599 2600 2601 2602 2603 2604 | static void PrintJumptableInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { | | | 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 | static void PrintJumptableInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { JumptableInfo *jtPtr = clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset, i = 0; hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { |
︙ | ︙ | |||
2627 2628 2629 2630 2631 2632 2633 | static void DisassembleJumptableInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { | | | 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 | static void DisassembleJumptableInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { JumptableInfo *jtPtr = clientData; Tcl_Obj *mapping = Tcl_NewObj(); Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset; hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
986 987 988 989 990 991 992 | * cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeByteCodeInternalRep( | | | 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 | * cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeByteCodeInternalRep( Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); assert(codePtr != NULL); TclReleaseByteCode(codePtr); |
︙ | ︙ | |||
1017 1018 1019 1020 1021 1022 1023 | * Also releases its literals and frees its auxiliary data items. * *---------------------------------------------------------------------- */ void TclPreserveByteCode( | | | | | | | 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 | * Also releases its literals and frees its auxiliary data items. * *---------------------------------------------------------------------- */ void TclPreserveByteCode( ByteCode *codePtr) { codePtr->refCount++; } void TclReleaseByteCode( ByteCode *codePtr) { if (codePtr->refCount-- > 1) { return; } /* Just dropped to refcount==0. Clean up. */ CleanupByteCode(codePtr); } static void CleanupByteCode( ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; Interp *iPtr = (Interp *) interp; int numLitObjects = codePtr->numLitObjects; int numAuxDataItems = codePtr->numAuxDataItems; Tcl_Obj **objArrayPtr, *objPtr; const AuxData *auxDataPtr; int i; #ifdef TCL_COMPILE_STATS if (interp != NULL) { ByteCodeStats *statsPtr; Tcl_Time destroyTime; int lifetimeSec, lifetimeMicroSec, log2; |
︙ | ︙ | |||
1388 1389 1390 1391 1392 1393 1394 | * the cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( | | | | 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 | * the cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; ByteCodeGetIntRep(objPtr, &substCodeType, codePtr); assert(codePtr != NULL); TclReleaseByteCode(codePtr); } |
︙ | ︙ | |||
1439 1440 1441 1442 1443 1444 1445 | *---------------------------------------------------------------------- */ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ | | | 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 | *---------------------------------------------------------------------- */ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ int numBytes, /* Number of bytes in source string. */ const CmdFrame *invoker, /* Location context invoking the bcc */ int word) /* Index of the word in that context getting * compiled */ { |
︙ | ︙ | |||
1646 1647 1648 1649 1650 1651 1652 | * corresponding ByteCode structure. * *---------------------------------------------------------------------- */ void TclFreeCompileEnv( | | | 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 | * corresponding ByteCode structure. * *---------------------------------------------------------------------- */ void TclFreeCompileEnv( CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){ ckfree(envPtr->localLitTable.buckets); envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } if (envPtr->iPtr) { /* |
︙ | ︙ | |||
2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 | { int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last * command this routine compiles into bytecode. * Initial value of -1 indicates this routine * has not yet generated any bytecode. */ const char *p = script; /* Where we are in our compile. */ int depth = TclGetStackDepth(envPtr); if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } | > > > > > > > > > > > > > > | > | > > > > > | > > | | | | > | | | | | | | | | > > > > > > | > > | | > > > | 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 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 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 | { int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last * command this routine compiles into bytecode. * Initial value of -1 indicates this routine * has not yet generated any bytecode. */ const char *p = script; /* Where we are in our compile. */ int depth = TclGetStackDepth(envPtr); Interp *iPtr = (Interp *) interp; if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } /* * Check depth to avoid overflow of the C execution stack by too many * nested calls of TclCompileScript (considering interp recursionlimit). * Factor 5/4 (1.25) is used to avoid too mistaken limit recognition * during "mixed" evaluation and compilation process (nested eval+compile) * and is good enough for default recursionlimit (1000). */ if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "too many nested compilations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); TclCompileSyntaxError(interp, envPtr); return; } /* Each iteration compiles one command from the script. */ if (numBytes > 0) { /* * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so * many nested compilations (body enclosed in body) can cause abnormal * program termination with a stack overflow exception, bug [fec0c17d39]. */ Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse)); do { const char *next; if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) { /* * Compile bytecodes to report the parsePtr error at runtime. */ Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, parsePtr->term + 1 - parsePtr->commandStart); TclCompileSyntaxError(interp, envPtr); ckfree(parsePtr); return; } #ifdef TCL_COMPILE_DEBUG /* * If tracing, print a line for each top level command compiled. * TODO: Suppress when numWords == 0 ? */ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { int commandLength = parsePtr->term - parsePtr->commandStart; fprintf(stdout, " Compiling: "); TclPrintSource(stdout, parsePtr->commandStart, TclMin(commandLength, 55)); fprintf(stdout, "\n"); } #endif /* * TIP #280: Count newlines before the command start. * (See test info-30.33). */ TclAdvanceLines(&envPtr->line, p, parsePtr->commandStart); TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, parsePtr->commandStart - envPtr->source); /* * Advance parser to the next command in the script. */ next = parsePtr->commandStart + parsePtr->commandSize; numBytes -= next - p; p = next; if (parsePtr->numWords == 0) { /* * The "command" parsed has no words. In this case we can skip * the rest of the loop body. With no words, clearly * CompileCommandTokens() has nothing to do. Since the parser * aggressively sucks up leading comment and white space, * including newlines, parsePtr->commandStart must be pointing at * either the end of script, or a command-terminating semi-colon. * In either case, the TclAdvance*() calls have nothing to do. * Finally, when no words are parsed, no tokens have been * allocated at parsePtr->tokenPtr so there's also nothing for * Tcl_FreeParse() to do. * * The advantage of this shortcut is that CompileCommandTokens() * can be written with an assumption that parsePtr->numWords > 0, with * the implication the CCT() always generates bytecode. */ continue; } /* * Avoid stack exhaustion by too many nested calls of TclCompileScript * (considering interp recursionlimit). */ iPtr->numLevels++; lastCmdIdx = CompileCommandTokens(interp, parsePtr, envPtr); iPtr->numLevels--; /* * TIP #280: Track lines in the just compiled command. */ TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p); TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, p - envPtr->source); Tcl_FreeParse(parsePtr); } while (numBytes > 0); ckfree(parsePtr); } if (lastCmdIdx == -1) { /* * Compiling the script yielded no bytecode. The script must be all * whitespace, comments, and empty commands. Such scripts are defined * to successfully produce the empty string result, so we emit the |
︙ | ︙ | |||
2778 2779 2780 2781 2782 2783 2784 | envPtr->literalArrayPtr[i].objPtr = copyPtr; } } } ByteCode * TclInitByteCode( | | | | | 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 | envPtr->literalArrayPtr[i].objPtr = copyPtr; } } } ByteCode * TclInitByteCode( CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { ByteCode *codePtr; size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes; size_t auxDataArrayBytes, structureSize; unsigned char *p; #ifdef TCL_COMPILE_DEBUG unsigned char *nextPtr; #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; int i, isNew; Interp *iPtr; |
︙ | ︙ | |||
2919 2920 2921 2922 2923 2924 2925 | ByteCode * TclInitByteCodeObj( Tcl_Obj *objPtr, /* Points object that should be initialized, * and whose string rep contains the source * code. */ const Tcl_ObjType *typePtr, | | | 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 | ByteCode * TclInitByteCodeObj( Tcl_Obj *objPtr, /* Points object that should be initialized, * and whose string rep contains the source * code. */ const Tcl_ObjType *typePtr, CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { ByteCode *codePtr; PreventCycle(objPtr, envPtr); codePtr = TclInitByteCode(envPtr); |
︙ | ︙ | |||
2964 2965 2966 2967 2968 2969 2970 | * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ int TclFindCompiledLocal( | | | | | 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 | * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ int TclFindCompiledLocal( const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ int nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ CompileEnv *envPtr) /* Points to the current compile environment*/ { CompiledLocal *localPtr; int localVar = -1; int i; Proc *procPtr; /* * If not creating a temporary, does a local variable of the specified * name already exist? */ |
︙ | ︙ | |||
3347 3348 3349 3350 3351 3352 3353 | * *---------------------------------------------------------------------- */ int TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ | | | | | 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 | * *---------------------------------------------------------------------- */ int TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ CompileEnv *envPtr)/* Points to CompileEnv for which to create a * new ExceptionRange structure. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; int index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { /* * Expand the ExceptionRange array. The currently allocated entries * are stored between elements 0 and (envPtr->exceptArrayNext - 1) * [inclusive]. |
︙ | ︙ | |||
3715 3716 3717 3718 3719 3720 3721 | int TclCreateAuxData( ClientData clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ | | | | 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 | int TclCreateAuxData( ClientData clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { int index; /* Index for the new AuxData structure. */ AuxData *auxDataPtr; /* Points to the new AuxData structure */ index = envPtr->auxDataArrayNext; if (index >= envPtr->auxDataArrayEnd) { /* * Expand the AuxData array. The currently allocated entries are * stored between elements 0 and (envPtr->auxDataArrayNext - 1) |
︙ | ︙ | |||
3778 3779 3780 3781 3782 3783 3784 | * The JumpFixupArray structure is initialized. * *---------------------------------------------------------------------- */ void TclInitJumpFixupArray( | | | 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 | * The JumpFixupArray structure is initialized. * *---------------------------------------------------------------------- */ void TclInitJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * initialize. */ { fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace; fixupArrayPtr->next = 0; fixupArrayPtr->end = JUMPFIXUP_INIT_ENTRIES - 1; fixupArrayPtr->mallocedArray = 0; |
︙ | ︙ | |||
3810 3811 3812 3813 3814 3815 3816 | * array to the new one. * *---------------------------------------------------------------------- */ void TclExpandJumpFixupArray( | | | 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 | * array to the new one. * *---------------------------------------------------------------------- */ void TclExpandJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * enlarge. */ { /* * The currently allocated jump fixup entries are stored from fixup[0] up * to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd. |
︙ | ︙ | |||
3859 3860 3861 3862 3863 3864 3865 | * Allocated storage in the JumpFixupArray structure is freed. * *---------------------------------------------------------------------- */ void TclFreeJumpFixupArray( | | | 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 | * Allocated storage in the JumpFixupArray structure is freed. * *---------------------------------------------------------------------- */ void TclFreeJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * free. */ { if (fixupArrayPtr->mallocedArray) { ckfree(fixupArrayPtr->fixup); } } |
︙ | ︙ | |||
4306 4307 4308 4309 4310 4311 4312 | static int GetCmdLocEncodingSize( CompileEnv *envPtr) /* Points to compilation environment structure * containing the CmdLocation structure to * encode. */ { | | | 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 | static int GetCmdLocEncodingSize( CompileEnv *envPtr) /* Points to compilation environment structure * containing the CmdLocation structure to * encode. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; int codeDelta, codeLen, srcDelta, srcLen; int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext; /* The offsets in their respective byte * sequences where the next encoded offset or * length should go. */ int prevCodeOffset, prevSrcOffset, i; |
︙ | ︙ | |||
4390 4391 4392 4393 4394 4395 4396 | * encode. */ ByteCode *codePtr, /* ByteCode in which to encode envPtr's * command location information. */ unsigned char *startPtr) /* Points to the first byte in codePtr's * memory block where the location information * is to be stored. */ { | | | | | 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 | * encode. */ ByteCode *codePtr, /* ByteCode in which to encode envPtr's * command location information. */ unsigned char *startPtr) /* Points to the first byte in codePtr's * memory block where the location information * is to be stored. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; unsigned char *p = startPtr; int codeDelta, codeLen, srcDelta, srcLen, prevOffset; int i; /* * Encode the code offset for each command as a sequence of deltas. */ codePtr->codeDeltaStart = p; prevOffset = 0; |
︙ | ︙ | |||
4508 4509 4510 4511 4512 4513 4514 | void RecordByteCodeStats( ByteCode *codePtr) /* Points to ByteCode structure with info * to add to accumulated statistics. */ { Interp *iPtr = (Interp *) *codePtr->interpHandle; | | | 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 | void RecordByteCodeStats( ByteCode *codePtr) /* Points to ByteCode structure with info * to add to accumulated statistics. */ { Interp *iPtr = (Interp *) *codePtr->interpHandle; ByteCodeStats *statsPtr; if (iPtr == NULL) { /* Avoid segfaulting in case we're called in a deleted interp */ return; } statsPtr = &(iPtr->stats); |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
525 526 527 528 529 530 531 | #define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), (typePtr)); \ | | | 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 | #define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), (typePtr)); \ (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * Opcodes for the Tcl bytecode instructions. These must correspond to the * entries in the table of instruction descriptions, tclInstructionTable, in * tclCompile.c. Also, the order and number of the expression opcodes (e.g., * INST_LOR) must match the entries in the array operatorStrings in |
︙ | ︙ | |||
1213 1214 1215 1216 1217 1218 1219 | const char *script, const char *command, int length, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, | | | 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 | const char *script, const char *command, int length, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); /* *---------------------------------------------------------------- * Macros and flag values used by Tcl bytecode compilation and execution * modules inside the Tcl core but not used outside. |
︙ | ︙ | |||
1401 1402 1403 1404 1405 1406 1407 | * CompileEnv. The ANSI C "prototype" for this macro is: * * void TclEmitPush(int objIndex, CompileEnv *envPtr); */ #define TclEmitPush(objIndex, envPtr) \ do { \ | | | 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 | * CompileEnv. The ANSI C "prototype" for this macro is: * * void TclEmitPush(int objIndex, CompileEnv *envPtr); */ #define TclEmitPush(objIndex, envPtr) \ do { \ int _objIndexCopy = (objIndex); \ if (_objIndexCopy <= 255) { \ TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ } else { \ TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ } \ } while (0) |
︙ | ︙ |
Changes to generic/tclDTrace.d.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * tclDTrace.d -- * * Tcl DTrace provider. * * Copyright (c) 2007-2008 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ typedef struct Tcl_Obj Tcl_Obj; | < | | | | | | | | | | | | | | | | | | | | | | | 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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 | /* * tclDTrace.d -- * * Tcl DTrace provider. * * Copyright (c) 2007-2008 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ typedef struct Tcl_Obj Tcl_Obj; /* * Tcl DTrace probes */ provider tcl { /***************************** proc probes *****************************/ /* * tcl*:::proc-entry probe * triggered immediately before proc bytecode execution * arg0: proc name (string) * arg1: number of arguments (int) * arg2: array of proc argument objects (Tcl_Obj**) */ probe proc__entry(const char *name, int objc, struct Tcl_Obj **objv); /* * tcl*:::proc-return probe * triggered immediately after proc bytecode execution * arg0: proc name (string) * arg1: return code (int) */ probe proc__return(const char *name, int code); /* * tcl*:::proc-result probe * triggered after proc-return probe and result processing * arg0: proc name (string) * arg1: return code (int) * arg2: proc result (string) * arg3: proc result object (Tcl_Obj*) */ probe proc__result(const char *name, int code, const char *result, struct Tcl_Obj *resultobj); /* * tcl*:::proc-args probe * triggered before proc-entry probe, gives access to string * representation of proc arguments * arg0: proc name (string) * arg1-arg9: proc arguments or NULL (strings) */ probe proc__args(const char *name, const char *arg1, const char *arg2, const char *arg3, const char *arg4, const char *arg5, const char *arg6, const char *arg7, const char *arg8, const char *arg9); /* * tcl*:::proc-info probe * triggered before proc-entry probe, gives access to TIP 280 * information for the proc invocation (i.e. [info frame 0]) * arg0: TIP 280 cmd (string) * arg1: TIP 280 type (string) * arg2: TIP 280 proc (string) * arg3: TIP 280 file (string) * arg4: TIP 280 line (int) * arg5: TIP 280 level (int) * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ probe proc__info(const char *cmd, const char *type, const char *proc, const char *file, int line, int level, const char *method, const char *class); /***************************** cmd probes ******************************/ /* * tcl*:::cmd-entry probe * triggered immediately before commmand execution * arg0: command name (string) * arg1: number of arguments (int) * arg2: array of command argument objects (Tcl_Obj**) */ probe cmd__entry(const char *name, int objc, struct Tcl_Obj **objv); /* * tcl*:::cmd-return probe * triggered immediately after commmand execution * arg0: command name (string) * arg1: return code (int) */ probe cmd__return(const char *name, int code); /* * tcl*:::cmd-result probe * triggered after cmd-return probe and result processing * arg0: command name (string) * arg1: return code (int) * arg2: command result (string) * arg3: command result object (Tcl_Obj*) */ probe cmd__result(const char *name, int code, const char *result, struct Tcl_Obj *resultobj); /* * tcl*:::cmd-args probe * triggered before cmd-entry probe, gives access to string * representation of command arguments * arg0: command name (string) * arg1-arg9: command arguments or NULL (strings) */ probe cmd__args(const char *name, const char *arg1, const char *arg2, const char *arg3, const char *arg4, const char *arg5, const char *arg6, const char *arg7, const char *arg8, const char *arg9); /* * tcl*:::cmd-info probe * triggered before cmd-entry probe, gives access to TIP 280 * information for the command invocation (i.e. [info frame 0]) * arg0: TIP 280 cmd (string) * arg1: TIP 280 type (string) * arg2: TIP 280 proc (string) * arg3: TIP 280 file (string) * arg4: TIP 280 line (int) * arg5: TIP 280 level (int) * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ probe cmd__info(const char *cmd, const char *type, const char *proc, const char *file, int line, int level, const char *method, const char *class); /***************************** inst probes *****************************/ /* * tcl*:::inst-start probe * triggered immediately before execution of a bytecode * arg0: bytecode name (string) * arg1: depth of stack (int) * arg2: top of stack (Tcl_Obj**) */ probe inst__start(const char *name, int depth, struct Tcl_Obj **stack); /* * tcl*:::inst-done probe * triggered immediately after execution of a bytecode * arg0: bytecode name (string) * arg1: depth of stack (int) * arg2: top of stack (Tcl_Obj**) */ probe inst__done(const char *name, int depth, struct Tcl_Obj **stack); /***************************** obj probes ******************************/ /* * tcl*:::obj-create probe * triggered immediately after a new Tcl_Obj has been created * arg0: object created (Tcl_Obj*) */ |
︙ | ︙ | |||
159 160 161 162 163 164 165 | /***************************** tcl probes ******************************/ /* * tcl*:::tcl-probe probe * triggered when the ::tcl::dtrace command is called * arg0-arg9: command arguments (strings) */ | | | | | | | | 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 192 193 194 | /***************************** tcl probes ******************************/ /* * tcl*:::tcl-probe probe * triggered when the ::tcl::dtrace command is called * arg0-arg9: command arguments (strings) */ probe tcl__probe(const char *arg0, const char *arg1, const char *arg2, const char *arg3, const char *arg4, const char *arg5, const char *arg6, const char *arg7, const char *arg8, const char *arg9); }; /* * Tcl types and constants for use in DTrace scripts */ typedef struct Tcl_ObjType { const char *name; void *freeIntRepProc; void *dupIntRepProc; void *updateStringProc; void *setFromAnyProc; } Tcl_ObjType; struct Tcl_Obj { int refCount; char *bytes; int length; const Tcl_ObjType *typePtr; union { long longValue; double doubleValue; void *otherValuePtr; int64_t wideValue; struct { void *ptr1; |
︙ | ︙ |
Changes to generic/tclDate.c.
︙ | ︙ | |||
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; | > > > > > > > > > > > | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; time_t dateRelMonth; |
︙ | ︙ | |||
194 195 196 197 198 199 200 | /* * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; | < < < < < < < < < < < | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 | /* * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; # ifndef YY_NULLPTR # if defined __cplusplus && 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif |
︙ | ︙ | |||
2545 2546 2547 2548 2549 2550 2551 | } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { | | | | | 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 | } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { char *p; char *q; const TABLE *tp; int i, abbrev; /* * Make it lowercase. */ Tcl_UtfToLower(buff); |
︙ | ︙ | |||
2670 2671 2672 2673 2674 2675 2676 | static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { | | | | 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 | static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { char c; char *p; char buff[20]; int Count; location->first_column = yyInput - info->dateStart; for ( ; ; ) { while (TclIsSpaceProc(UCHAR(*yyInput))) { yyInput++; |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
1023 1024 1025 1026 1027 1028 1029 | const char *src, int srcLen, Tcl_DString *dsPtr); /* 334 */ EXTERN int Tcl_UtfToLower(char *src); /* 335 */ EXTERN int Tcl_UtfToTitle(char *src); /* 336 */ | | > | 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 | const char *src, int srcLen, Tcl_DString *dsPtr); /* 334 */ EXTERN int Tcl_UtfToLower(char *src); /* 335 */ EXTERN int Tcl_UtfToTitle(char *src); /* 336 */ EXTERN int Tcl_UtfToChar16(const char *src, unsigned short *chPtr); /* 337 */ EXTERN int Tcl_UtfToUpper(char *src); /* 338 */ EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen); /* 339 */ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); |
︙ | ︙ | |||
1064 1065 1066 1067 1068 1069 1070 | /* 352 */ EXTERN int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 354 */ | | | | 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 | /* 352 */ EXTERN int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 354 */ EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 355 */ EXTERN unsigned short * Tcl_UtfToChar16DString(const char *src, int length, Tcl_DString *dsPtr); /* 356 */ EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 357 */ TCL_DEPRECATED("Use Tcl_EvalTokensStandard") Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, |
︙ | ︙ | |||
1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 | /* 644 */ EXTERN int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 645 */ EXTERN int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; | > > > > > > > > | 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 | /* 644 */ EXTERN int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 645 */ EXTERN int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 646 */ EXTERN int Tcl_UtfToUniChar(const char *src, int *chPtr); /* 647 */ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 648 */ EXTERN int * Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; |
︙ | ︙ | |||
2271 2272 2273 2274 2275 2276 2277 | const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ const char * (*tcl_UtfNext) (const char *src); /* 330 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ int (*tcl_UtfToTitle) (char *src); /* 335 */ | | | | | 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 | const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ const char * (*tcl_UtfNext) (const char *src); /* 330 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ int (*tcl_UtfToTitle) (char *src); /* 335 */ int (*tcl_UtfToChar16) (const char *src, unsigned short *chPtr); /* 336 */ int (*tcl_UtfToUpper) (char *src); /* 337 */ int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */ int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ 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 */ int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ unsigned short * (*tcl_UtfToChar16DString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */ int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */ |
︙ | ︙ | |||
2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 | void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */ void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */ void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 645 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif | > > > | 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 | void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */ void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */ void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 645 */ int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 648 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
3283 3284 3285 3286 3287 3288 3289 | (tclStubsPtr->tcl_UtfToExternal) /* 332 */ #define Tcl_UtfToExternalDString \ (tclStubsPtr->tcl_UtfToExternalDString) /* 333 */ #define Tcl_UtfToLower \ (tclStubsPtr->tcl_UtfToLower) /* 334 */ #define Tcl_UtfToTitle \ (tclStubsPtr->tcl_UtfToTitle) /* 335 */ | | | | 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 | (tclStubsPtr->tcl_UtfToExternal) /* 332 */ #define Tcl_UtfToExternalDString \ (tclStubsPtr->tcl_UtfToExternalDString) /* 333 */ #define Tcl_UtfToLower \ (tclStubsPtr->tcl_UtfToLower) /* 334 */ #define Tcl_UtfToTitle \ (tclStubsPtr->tcl_UtfToTitle) /* 335 */ #define Tcl_UtfToChar16 \ (tclStubsPtr->tcl_UtfToChar16) /* 336 */ #define Tcl_UtfToUpper \ (tclStubsPtr->tcl_UtfToUpper) /* 337 */ #define Tcl_WriteChars \ (tclStubsPtr->tcl_WriteChars) /* 338 */ #define Tcl_WriteObj \ (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ |
︙ | ︙ | |||
3319 3320 3321 3322 3323 3324 3325 | (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ #define Tcl_UniCharLen \ (tclStubsPtr->tcl_UniCharLen) /* 352 */ #define Tcl_UniCharNcmp \ (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ | | | | | | 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 | (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ #define Tcl_UniCharLen \ (tclStubsPtr->tcl_UniCharLen) /* 352 */ #define Tcl_UniCharNcmp \ (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ #define Tcl_Char16ToUtfDString \ (tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */ #define Tcl_UtfToChar16DString \ (tclStubsPtr->tcl_UtfToChar16DString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ #define Tcl_EvalTokens \ (tclStubsPtr->tcl_EvalTokens) /* 357 */ #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #define Tcl_LogCommandInfo \ |
︙ | ︙ | |||
3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 | (tclStubsPtr->tcl_DecrRefCount) /* 642 */ #define Tcl_IsShared \ (tclStubsPtr->tcl_IsShared) /* 643 */ #define Tcl_LinkArray \ (tclStubsPtr->tcl_LinkArray) /* 644 */ #define Tcl_GetIntForIndex \ (tclStubsPtr->tcl_GetIntForIndex) /* 645 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp | > > > > > > | 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 | (tclStubsPtr->tcl_DecrRefCount) /* 642 */ #define Tcl_IsShared \ (tclStubsPtr->tcl_IsShared) /* 643 */ #define Tcl_LinkArray \ (tclStubsPtr->tcl_LinkArray) /* 644 */ #define Tcl_GetIntForIndex \ (tclStubsPtr->tcl_GetIntForIndex) /* 645 */ #define Tcl_UtfToUniChar \ (tclStubsPtr->tcl_UtfToUniChar) /* 646 */ #define Tcl_UniCharToUtfDString \ (tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */ #define Tcl_UtfToUniCharDString \ (tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp |
︙ | ︙ | |||
4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 | #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) #undef Tcl_GetUnicode #define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) #undef Tcl_BackgroundError #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) /* * Deprecated Tcl procedures: */ #undef Tcl_EvalObj #define Tcl_EvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, 0) #undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) #endif /* _TCLDECLS */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 | #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) #undef Tcl_GetUnicode #define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) #undef Tcl_BackgroundError #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_UTF_MAX <= 4 # 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 #if defined(USE_TCL_STUBS) # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, int, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, int, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToChar16 \ : (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar) #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))Tcl_UtfToChar16 \ : (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar) #endif /* * Deprecated Tcl procedures: */ #undef Tcl_EvalObj #define Tcl_EvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, 0) #undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) #endif /* _TCLDECLS */ |
Changes to generic/tclDictObj.c.
︙ | ︙ | |||
3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 | * Force loop termination by calling Tcl_DictObjDone; this * makes the next Tcl_DictObjNext say there is nothing more to * do. */ Tcl_ResetResult(interp); Tcl_DictObjDone(&search); case TCL_CONTINUE: result = TCL_OK; break; case TCL_ERROR: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"dict filter\" script line %d)", Tcl_GetErrorLine(interp))); | > | 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 | * Force loop termination by calling Tcl_DictObjDone; this * makes the next Tcl_DictObjNext say there is nothing more to * do. */ Tcl_ResetResult(interp); Tcl_DictObjDone(&search); /* FALLTHRU */ case TCL_CONTINUE: result = TCL_OK; break; case TCL_ERROR: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"dict filter\" script line %d)", Tcl_GetErrorLine(interp))); |
︙ | ︙ | |||
3305 3306 3307 3308 3309 3310 3311 | for (i=2 ; i+2<objc ; i+=2) { if (Tcl_DictObjGet(interp, dictPtr, objv[i], &objPtr) != TCL_OK) { TclDecrRefCount(dictPtr); return TCL_ERROR; } if (objPtr == NULL) { /* ??? */ | | | 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 | for (i=2 ; i+2<objc ; i+=2) { if (Tcl_DictObjGet(interp, dictPtr, objv[i], &objPtr) != TCL_OK) { TclDecrRefCount(dictPtr); return TCL_ERROR; } if (objPtr == NULL) { /* ??? */ Tcl_UnsetVar2(interp, Tcl_GetString(objv[i+1]), NULL, 0); } else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(dictPtr); return TCL_ERROR; } } TclDecrRefCount(dictPtr); |
︙ | ︙ |
Changes to generic/tclDisassemble.c.
︙ | ︙ | |||
538 539 540 541 542 543 544 | FormatInstruction( ByteCode *codePtr, /* Bytecode containing the instruction. */ const unsigned char *pc, /* Points to first byte of instruction. */ Tcl_Obj *bufferObj) /* Object to append instruction info to. */ { Proc *procPtr = codePtr->procPtr; unsigned char opCode = *pc; | | | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | FormatInstruction( ByteCode *codePtr, /* Bytecode containing the instruction. */ const unsigned char *pc, /* Points to first byte of instruction. */ Tcl_Obj *bufferObj) /* Object to append instruction info to. */ { Proc *procPtr = codePtr->procPtr; unsigned char opCode = *pc; const InstructionDesc *instDesc = &tclInstructionTable[opCode]; unsigned char *codeStart = codePtr->codeStart; unsigned pcOffset = pc - codeStart; int opnd = 0, i, j, numBytes = 1; int localCt = procPtr ? procPtr->numCompiledLocals : 0; CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL; char suffixBuffer[128]; /* Additional info to print after main opcode * and immediates. */ |
︙ | ︙ | |||
859 860 861 862 863 864 865 | static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { | | | | 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 | static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { const char *p; int i = 0, len; Tcl_UniChar ch = 0; if (stringPtr == NULL) { Tcl_AppendToObj(appendObj, "\"\"", -1); return; } |
︙ | ︙ |
Changes to generic/tclEncoding.c.
︙ | ︙ | |||
3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 | int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int result, numChars; result = TCL_OK; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } dstStart = dst; dstEnd = dst + dstLen - 1; for (numChars = 0; src < srcEnd; numChars++) { | > < | 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 | int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int result, numChars; Tcl_UniChar ch = 0; result = TCL_OK; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } dstStart = dst; dstEnd = dst + dstLen - 1; for (numChars = 0; src < srcEnd; numChars++) { int len; if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ |
︙ | ︙ | |||
3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 | const Encoding *encodingPtr; const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int state, result, numChars; const TableEncodingData *tableDataPtr; const char *tablePrefixBytes; const unsigned short *const *tableFromUnicode; result = TCL_OK; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { | > | 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 | const Encoding *encodingPtr; const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int state, result, numChars; const TableEncodingData *tableDataPtr; const char *tablePrefixBytes; const unsigned short *const *tableFromUnicode; Tcl_UniChar ch = 0; result = TCL_OK; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { |
︙ | ︙ | |||
3526 3527 3528 3529 3530 3531 3532 | tablePrefixBytes = tableDataPtr->prefixBytes; tableFromUnicode = (const unsigned short *const *) tableDataPtr->fromUnicode; for (numChars = 0; src < srcEnd; numChars++) { unsigned len; int word; | < | 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 | tablePrefixBytes = tableDataPtr->prefixBytes; tableFromUnicode = (const unsigned short *const *) tableDataPtr->fromUnicode; for (numChars = 0; src < srcEnd; numChars++) { unsigned len; int word; if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ |
︙ | ︙ |
Changes to generic/tclEnsemble.c.
︙ | ︙ | |||
115 116 117 118 119 120 121 | * table. */ } EnsembleCmdRep; static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) { | | | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | * table. */ } EnsembleCmdRep; static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) { Namespace *nsPtr = (Namespace *) namespacePtr; if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { return Tcl_NewStringObj("::", 2); } return Tcl_NewStringObj(nsPtr->fullName, -1); } |
︙ | ︙ | |||
1809 1810 1811 1812 1813 1814 1815 | char *fullName = NULL; /* Full name of the subcommand. */ int stringLength, i; int tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; subcmdName = TclGetStringFromObj(subObj, &stringLength); for (i=0 ; i<tableLength ; i++) { | | | 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 | char *fullName = NULL; /* Full name of the subcommand. */ int stringLength, i; int tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; subcmdName = TclGetStringFromObj(subObj, &stringLength); for (i=0 ; i<tableLength ; i++) { int cmp = strncmp(subcmdName, ensemblePtr->subcommandArrayPtr[i], stringLength); if (cmp == 0) { if (fullName != NULL) { /* * Since there's never the exact-match case to worry about |
︙ | ︙ | |||
2400 2401 2402 2403 2404 2405 2406 | static void MakeCachedEnsembleCommand( Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, Tcl_Obj *fix) { | | | 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 | static void MakeCachedEnsembleCommand( Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, Tcl_Obj *fix) { EnsembleCmdRep *ensembleCmd; ECRGetIntRep(objPtr, ensembleCmd); if (ensembleCmd) { TclCleanupCommandMacro(ensembleCmd->token); if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } |
︙ | ︙ | |||
2576 2577 2578 2579 2580 2581 2582 | ClearTable(ensemblePtr); Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { int subc; Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; | | | 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 | ClearTable(ensemblePtr); Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { int subc; Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; const char *name; /* * There is a list of exactly what subcommands go in the table. * Must determine the target for each. */ Tcl_ListObjGetElements(NULL, subList, &subc, &subv); |
︙ | ︙ | |||
2661 2662 2663 2664 2665 2666 2667 | Tcl_DictSearch dictSearch; Tcl_Obj *keyObj, *valueObj; int done; Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, &keyObj, &valueObj, &done); while (!done) { | | | 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 | Tcl_DictSearch dictSearch; Tcl_Obj *keyObj, *valueObj; int done; Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, &keyObj, &valueObj, &done); while (!done) { const char *name = TclGetString(keyObj); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); Tcl_SetHashValue(hPtr, valueObj); Tcl_IncrRefCount(valueObj); Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); } } else { |
︙ | ︙ | |||
3375 3376 3377 3378 3379 3380 3381 | Tcl_Parse *parsePtr, Tcl_Obj *replacements, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokPtr; Tcl_Obj *objPtr, **words; | | | 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 | Tcl_Parse *parsePtr, Tcl_Obj *replacements, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokPtr; Tcl_Obj *objPtr, **words; const char *bytes; int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME; DefineLineInformation; /* * Push the words of the command. Take care; the command words may be * scripts that have backslashes in them, and [info frame 0] can see the * difference. Hence the call to TclContinuationsEnterDerived... |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
1323 1324 1325 1326 1327 1328 1329 | *-------------------------------------------------------------- */ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 | *-------------------------------------------------------------- */ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Points to Tcl object containing expression * to evaluate. */ Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ { NRE_callback *rootPtr = TOP_CB(interp); Tcl_Obj *resultPtr; |
︙ | ︙ | |||
1440 1441 1442 1443 1444 1445 1446 | CompileExprObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ | | | 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 | CompileExprObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ /* * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ |
︙ | ︙ | |||
1594 1595 1596 1597 1598 1599 1600 | ByteCode * TclCompileObj( Tcl_Interp *interp, Tcl_Obj *objPtr, const CmdFrame *invoker, int word) { | | | | 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 | ByteCode * TclCompileObj( Tcl_Interp *interp, Tcl_Obj *objPtr, const CmdFrame *invoker, int word) { Interp *iPtr = (Interp *) interp; ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* * If the object is not already of tclByteCodeType, compile it (and reset * the compilation flags in the interpreter; this should be done after any * compilation). Otherwise, check that it is "fresh" enough. */ |
︙ | ︙ | |||
1977 1978 1979 1980 1981 1982 1983 | TclResetRewriteEnsemble(interp, 1); /* * Push the callback for bytecode execution */ TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL, | | > > > > > > > | 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 | TclResetRewriteEnsemble(interp, 1); /* * Push the callback for bytecode execution */ TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL, /* cleanup */ INT2PTR(0), INT2PTR(iPtr->evalFlags)); /* * Reset discard result flag - because it is applicable for this call only, * and should not affect all the nested invocations may return result. */ iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT; return TCL_OK; } static int TEBCresume( ClientData data[], Tcl_Interp *interp, |
︙ | ︙ | |||
2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 | * used too frequently */ TEBCdata *TD = data[0]; #define auxObjList (TD->auxObjList) #define catchTop (TD->catchTop) #define codePtr (TD->codePtr) /* * Globals: variables that store state, must remain valid at all times. */ Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc = data[1]; /* The current program counter. */ unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while * executing an instruction. */ int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; | > | | 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 | * used too frequently */ TEBCdata *TD = data[0]; #define auxObjList (TD->auxObjList) #define catchTop (TD->catchTop) #define codePtr (TD->codePtr) #define curEvalFlags PTR2INT(data[3]) /* calling iPtr->evalFlags */ /* * Globals: variables that store state, must remain valid at all times. */ Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc = data[1]; /* The current program counter. */ unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while * executing an instruction. */ int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* * Locals - variables that are used within opcodes or bounded sections of * the file (jumps between opcodes within a family). * NOTE: These are now mostly defined locally where needed. */ |
︙ | ︙ | |||
2092 2093 2094 2095 2096 2097 2098 | fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH); fflush(stdout); } #endif if (!pc) { /* bytecode is starting from scratch */ | < | 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 | fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH); fflush(stdout); } #endif if (!pc) { /* bytecode is starting from scratch */ pc = codePtr->codeStart; goto cleanup0; } else { /* resume from invocation */ CACHE_STACK_INFO(); NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); |
︙ | ︙ | |||
2114 2115 2116 2117 2118 2119 2120 | TclArgumentBCRelease(interp, bcFramePtr); } if (iPtr->execEnvPtr->rewind) { result = TCL_ERROR; goto abnormalReturn; } if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { | < > > | 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 | TclArgumentBCRelease(interp, bcFramePtr); } if (iPtr->execEnvPtr->rewind) { result = TCL_ERROR; goto abnormalReturn; } if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; checkInterp = 1; iPtr->flags |= ERR_ALREADY_LOGGED; } if (result != TCL_OK) { pc--; goto processExceptionReturn; } |
︙ | ︙ | |||
2175 2176 2177 2178 2179 2180 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 | goto cleanup0; default: cleanup -= 2; while (cleanup--) { objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } case 2: cleanup2_pushObjResultPtr: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); case 1: cleanup1_pushObjResultPtr: objPtr = OBJ_AT_TOS; TclDecrRefCount(objPtr); } OBJ_AT_TOS = objResultPtr; goto cleanup0; cleanupV: switch (cleanup) { default: cleanup -= 2; while (cleanup--) { objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } case 2: cleanup2: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); case 1: cleanup1: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); case 0: /* * We really want to do nothing now, but this is needed for some * compilers (SunPro CC). */ break; | > > > > > | 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 2229 | goto cleanup0; default: cleanup -= 2; while (cleanup--) { objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } /* FALLTHRU */ case 2: cleanup2_pushObjResultPtr: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); /* FALLTHRU */ case 1: cleanup1_pushObjResultPtr: objPtr = OBJ_AT_TOS; TclDecrRefCount(objPtr); } OBJ_AT_TOS = objResultPtr; goto cleanup0; cleanupV: switch (cleanup) { default: cleanup -= 2; while (cleanup--) { objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } /* FALLTHRU */ case 2: cleanup2: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); /* FALLTHRU */ case 1: cleanup1: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); /* FALLTHRU */ case 0: /* * We really want to do nothing now, but this is needed for some * compilers (SunPro CC). */ break; |
︙ | ︙ | |||
2290 2291 2292 2293 2294 2295 2296 | } else if (inst == INST_START_CMD) { /* * Peephole: do not run INST_START_CMD, just skip it */ iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); if (checkInterp) { | < > | 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 | } else if (inst == INST_START_CMD) { /* * Peephole: do not run INST_START_CMD, just skip it */ iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); if (checkInterp) { if (((codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) && !(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { goto instStartCmdFailed; } checkInterp = 0; } inst = *(pc += 9); goto peepholeStart; } else if (inst == INST_NOP) { #ifndef TCL_COMPILE_DEBUG while (inst == INST_NOP) #endif |
︙ | ︙ | |||
2489 2490 2491 2492 2493 2494 2495 | CACHE_STACK_INFO(); goto gotError; } #ifdef TCL_COMPILE_DEBUG /* FIXME: What is the right thing to trace? */ { | | | 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 | CACHE_STACK_INFO(); goto gotError; } #ifdef TCL_COMPILE_DEBUG /* FIXME: What is the right thing to trace? */ { int i; TRACE(("%d [", opnd)); for (i=opnd-1 ; i>=0 ; i--) { TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i)))); if (i > 0) { TRACE_APPEND((" ")); } |
︙ | ︙ | |||
2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 | result = TCL_RETURN; cleanup = opnd; goto processExceptionReturn; } case INST_DONE: if (tosPtr > initTosPtr) { /* * Set the interpreter's object result to point to the topmost * object from the stack, and check for a possible [catch]. The * stackTop's level and refCount will be handled by "processCatch" * or "abnormalReturn". */ | > > > > > > > > | 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 | result = TCL_RETURN; cleanup = opnd; goto processExceptionReturn; } case INST_DONE: if (tosPtr > initTosPtr) { if ((curEvalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) { /* simulate pop & fast done (like it does continue in loop) */ TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); goto abnormalReturn; } /* * Set the interpreter's object result to point to the topmost * object from the stack, and check for a possible [catch]. The * stackTop's level and refCount will be handled by "processCatch" * or "abnormalReturn". */ |
︙ | ︙ | |||
2721 2722 2723 2724 2725 2726 2727 | return TclNRExecuteByteCode(interp, newCodePtr); } /* * INVOCATION BLOCK */ | < > > > > | | 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 | return TclNRExecuteByteCode(interp, newCodePtr); } /* * INVOCATION BLOCK */ case INST_EVAL_STK: instEvalStk: bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; cleanup = 1; pc += 1; /* yield next instruction */ TEBC_YIELD(); /* add TEBCResume for object at top of stack */ return TclNRExecuteByteCode(interp, TclCompileObj(interp, OBJ_AT_TOS, NULL, 0)); case INST_INVOKE_EXPANDED: CLANG_ASSERT(auxObjList); objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2); POP_TAUX_OBJ(); if (objc) { pcAdjustment = 1; |
︙ | ︙ | |||
4391 4392 4393 4394 4395 4396 4397 | } 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; | | | | 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 | } 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) { TRACE_ERROR(interp); goto gotError; } if (level <= 0) { |
︙ | ︙ | |||
4689 4690 4691 4692 4693 4694 4695 | || contextPtr->callPtr->flags & FILTER_HANDLING) { oPtr->flags |= FILTER_HANDLING; } else { oPtr->flags &= ~FILTER_HANDLING; } { | | | 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 | || contextPtr->callPtr->flags & FILTER_HANDLING) { oPtr->flags |= FILTER_HANDLING; } else { oPtr->flags &= ~FILTER_HANDLING; } { Method *const mPtr = contextPtr->callPtr->chain[newDepth].mPtr; return mPtr->typePtr->callProc(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, opnd, objv); } case INST_TCLOO_IS_OBJECT: |
︙ | ︙ | |||
6779 6780 6781 6782 6783 6784 6785 | O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); case INST_DICT_EXISTS: { | | | 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 | 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); if (opnd > 1) { dictPtr = TclTraceDictPath(NULL, dictPtr, opnd-1, &OBJ_AT_DEPTH(opnd-1), DICT_PATH_EXISTS); |
︙ | ︙ | |||
7691 7692 7693 7694 7695 7696 7697 | NEXT_INST_F(0, 0, 0); /* Restart the execution loop at pc. */ /* * end of infinite loop dispatching on instructions. */ /* | | | 7715 7716 7717 7718 7719 7720 7721 7722 7723 7724 7725 7726 7727 7728 7729 | NEXT_INST_F(0, 0, 0); /* Restart the execution loop at pc. */ /* * end of infinite loop dispatching on instructions. */ /* * Done or abnormal return code. Restore the stack to state it had when * starting to execute the ByteCode. Panic if the stack is below the * initial level. */ abnormalReturn: TCL_DTRACE_INST_LAST(); |
︙ | ︙ | |||
7746 7747 7748 7749 7750 7751 7752 | * case INST_START_CMD: */ instStartCmdFailed: { const char *bytes; | < > > > > | < | > | | > | < | 7770 7771 7772 7773 7774 7775 7776 7777 7778 7779 7780 7781 7782 7783 7784 7785 7786 7787 7788 7789 7790 7791 7792 7793 7794 7795 7796 7797 7798 7799 | * case INST_START_CMD: */ instStartCmdFailed: { const char *bytes; length = 0; if (TclInterpReady(interp) == TCL_ERROR) { goto gotError; } /* * We used to switch to direct eval; for NRE-awareness we now * compile and eval the command so that this evaluation does not * add a new TEBC instance. Bug [2910748], bug [fa6bf38d07] * * TODO: recompile, search this command and eval a code starting from, * so that this evaluation does not add a new TEBC instance without * NRE-trampoline. */ codePtr->flags |= TCL_BYTECODE_RECOMPILE; bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL); opnd = TclGetUInt4AtPtr(pc+1); pc += (opnd-1); assert(bytes); PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); goto instEvalStk; |
︙ | ︙ | |||
8448 8449 8450 8451 8452 8453 8454 | || (Tcl_WideUInt)w2 >= (1<<28)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); mp_init(&bigResult); | | | 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 | || (Tcl_WideUInt)w2 >= (1<<28)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); mp_init(&bigResult); mp_expt_d(&big1, (mp_digit)w2, &bigResult); mp_clear(&big1); BIG_RESULT(&bigResult); } case INST_ADD: case INST_SUB: case INST_MULT: |
︙ | ︙ | |||
8880 8881 8882 8883 8884 8885 8886 | * None. * *---------------------------------------------------------------------- */ static void PrintByteCodeInfo( | | | 8907 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 8919 8920 8921 | * None. * *---------------------------------------------------------------------- */ static void PrintByteCodeInfo( ByteCode *codePtr) /* The bytecode whose summary is printed to * stdout. */ { Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n", codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr, |
︙ | ︙ | |||
8944 8945 8946 8947 8948 8949 8950 | * *---------------------------------------------------------------------- */ #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( | | | 8971 8972 8973 8974 8975 8976 8977 8978 8979 8980 8981 8982 8983 8984 8985 | * *---------------------------------------------------------------------- */ #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( ByteCode *codePtr, /* The bytecode whose summary is printed to * stdout. */ const unsigned char *pc, /* Points to first byte of a bytecode * instruction. The program counter. */ int stackTop, /* Current stack top. Must be between * stackLowerBound and stackUpperBound * (inclusive). */ int checkStack) /* 0 if the stack depth check should be |
︙ | ︙ | |||
9187 9188 9189 9190 9191 9192 9193 | const unsigned char **pcBeg,/* If non-NULL, the bytecode location * where the current instruction starts. * If NULL; no pointer is stored. */ int *cmdIdxPtr) /* If non-NULL, the location where the index * of the command containing the pc should * be stored. */ { | | | 9214 9215 9216 9217 9218 9219 9220 9221 9222 9223 9224 9225 9226 9227 9228 | const unsigned char **pcBeg,/* If non-NULL, the bytecode location * where the current instruction starts. * If NULL; no pointer is stored. */ int *cmdIdxPtr) /* If non-NULL, the location where the index * of the command containing the pc should * be stored. */ { int pcOffset = (pc - codePtr->codeStart); int numCmds = codePtr->numCommands; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ |
︙ | ︙ | |||
9340 9341 9342 9343 9344 9345 9346 | * for loop ranges that define a continue * point or a catch range. */ ByteCode *codePtr) /* Points to the ByteCode in which to search * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; | | | | 9367 9368 9369 9370 9371 9372 9373 9374 9375 9376 9377 9378 9379 9380 9381 9382 9383 | * for loop ranges that define a continue * point or a catch range. */ ByteCode *codePtr) /* Points to the ByteCode in which to search * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; ExceptionRange *rangePtr; int pcOffset = pc - codePtr->codeStart; int start; if (numRanges == 0) { return NULL; } /* * This exploits peculiarities of our compiler: nested ranges are always |
︙ | ︙ | |||
9474 9475 9476 9477 9478 9479 9480 | * None. * *---------------------------------------------------------------------- */ int TclLog2( | | | | | 9501 9502 9503 9504 9505 9506 9507 9508 9509 9510 9511 9512 9513 9514 9515 9516 9517 9518 9519 | * None. * *---------------------------------------------------------------------- */ int TclLog2( int value) /* The integer for which to compute the log * base 2. */ { int n = value; int result = 0; while (n > 1) { n = n >> 1; result++; } return result; } |
︙ | ︙ |
Changes to generic/tclFileName.c.
︙ | ︙ | |||
1068 1069 1070 1071 1072 1073 1074 | /* * Convert forward slashes to backslashes in Windows paths because some * system interfaces don't accept forward slashes. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { | | | 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 | /* * Convert forward slashes to backslashes in Windows paths because some * system interfaces don't accept forward slashes. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { char *p; for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '/') { *p = '\\'; } } } |
︙ | ︙ | |||
2073 2074 2075 2076 2077 2078 2079 | static int SkipToChar( char **stringPtr, /* Pointer string to check. */ int match) /* Character to find. */ { int quoted, level; | | | 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 | static int SkipToChar( char **stringPtr, /* Pointer string to check. */ int match) /* Character to find. */ { int quoted, level; char *p; quoted = 0; level = 0; for (p = *stringPtr; *p != '\0'; p++) { if (quoted) { quoted = 0; |
︙ | ︙ | |||
2624 2625 2626 2627 2628 2629 2630 | Tcl_WideUInt Tcl_GetBlocksFromStat( const Tcl_StatBuf *statPtr) { #ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (Tcl_WideUInt) statPtr->st_blocks; #else | | | 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 | Tcl_WideUInt Tcl_GetBlocksFromStat( const Tcl_StatBuf *statPtr) { #ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (Tcl_WideUInt) statPtr->st_blocks; #else unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize; #endif } unsigned Tcl_GetBlockSizeFromStat( |
︙ | ︙ |
Changes to generic/tclGetDate.y.
︙ | ︙ | |||
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 | * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; | > > > > > > > > | | 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 | * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; time_t dateRelMonth; |
︙ | ︙ | |||
146 147 148 149 150 151 152 | * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; | < < < < < < < < | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; %} %union { time_t Number; enum _MERIDIAN Meridian; } |
︙ | ︙ | |||
761 762 763 764 765 766 767 | } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { | | | | | 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 | } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { char *p; char *q; const TABLE *tp; int i, abbrev; /* * Make it lowercase. */ Tcl_UtfToLower(buff); |
︙ | ︙ | |||
886 887 888 889 890 891 892 | static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { | | | | 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 | static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { char c; char *p; char buff[20]; int Count; location->first_column = yyInput - info->dateStart; for ( ; ; ) { while (TclIsSpaceProc(UCHAR(*yyInput))) { yyInput++; |
︙ | ︙ |
Changes to generic/tclHash.c.
︙ | ︙ | |||
109 110 111 112 113 114 115 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitHashTable( | | | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitHashTable( Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType) /* Type of keys to use in table: * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an * integer >= 2. */ { /* |
︙ | ︙ | |||
147 148 149 150 151 152 153 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitCustomHashTable( | | | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitCustomHashTable( Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType, /* Type of keys to use in table: * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS, * or an integer >= 2. */ const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the |
︙ | ︙ | |||
267 268 269 270 271 272 273 | CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { | | | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 | CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; unsigned int hash; int index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { |
︙ | ︙ | |||
388 389 390 391 392 393 394 | *---------------------------------------------------------------------- */ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { | | | 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 | *---------------------------------------------------------------------- */ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { Tcl_HashEntry *prevPtr; const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; int index; tablePtr = entryPtr->tablePtr; |
︙ | ︙ | |||
457 458 459 460 461 462 463 | * The hash table is no longer useable. * *---------------------------------------------------------------------- */ void Tcl_DeleteHashTable( | | | | 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 | * The hash table is no longer useable. * *---------------------------------------------------------------------- */ void Tcl_DeleteHashTable( Tcl_HashTable *tablePtr) /* Table to delete. */ { Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; int i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; |
︙ | ︙ | |||
565 566 567 568 569 570 571 | * None. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_NextHashEntry( | | | 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 | * None. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_NextHashEntry( Tcl_HashSearch *searchPtr) /* Place to store information about progress * through the table. Must have been * initialized by calling * Tcl_FirstHashEntry. */ { Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr = searchPtr->tablePtr; |
︙ | ︙ | |||
612 613 614 615 616 617 618 | char * Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; double average, tmp; | | | 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | char * Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; double average, tmp; Tcl_HashEntry *hPtr; char *result, *p; /* * Compute a histogram of bucket usage. */ for (i = 0; i < NUM_COUNTERS; i++) { |
︙ | ︙ | |||
682 683 684 685 686 687 688 | static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; | | | 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 | static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; int *iPtr1, *iPtr2; Tcl_HashEntry *hPtr; int count; unsigned int size; count = tablePtr->keyType; size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key); |
︙ | ︙ | |||
726 727 728 729 730 731 732 | */ static int CompareArrayKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { | | | | 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 | */ static int CompareArrayKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { const int *iPtr1 = (const int *) keyPtr; const int *iPtr2 = (const int *) hPtr->key.words; Tcl_HashTable *tablePtr = hPtr->tablePtr; int count; for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { if (count == 0) { return 1; } |
︙ | ︙ | |||
765 766 767 768 769 770 771 | */ static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { | | | | 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 | */ static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { const int *array = (const int *) keyPtr; unsigned int result; int count; for (result = 0, count = tablePtr->keyType; count > 0; count--, array++) { result += *array; } return (TCL_HASH_TYPE) result; |
︙ | ︙ | |||
806 807 808 809 810 811 812 813 814 815 816 817 818 819 | unsigned int size, allocsize; allocsize = size = strlen(string) + 1; if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } hPtr = ckalloc(offsetof(Tcl_HashEntry, key) + allocsize); memcpy(hPtr->key.string, string, size); hPtr->clientData = 0; return hPtr; } /* *---------------------------------------------------------------------- | > | 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 | unsigned int size, allocsize; allocsize = size = strlen(string) + 1; if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } hPtr = ckalloc(offsetof(Tcl_HashEntry, key) + allocsize); memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key)); memcpy(hPtr->key.string, string, size); hPtr->clientData = 0; return hPtr; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
833 834 835 836 837 838 839 | */ static int CompareStringKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { | | | | 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 | */ static int CompareStringKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { const char *p1 = (const char *) keyPtr; const char *p2 = (const char *) hPtr->key.string; return !strcmp(p1, p2); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
861 862 863 864 865 866 867 | */ static TCL_HASH_TYPE HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { | | | | | 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 | */ static TCL_HASH_TYPE HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { const char *string = keyPtr; unsigned int result; char c; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose * the one below (multiply by 9 and add new character) because of the * following reasons: |
︙ | ︙ | |||
982 983 984 985 986 987 988 | * Memory gets reallocated and entries get re-hashed to new buckets. * *---------------------------------------------------------------------- */ static void RebuildTable( | | | | | 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 | * Memory gets reallocated and entries get re-hashed to new buckets. * *---------------------------------------------------------------------- */ static void RebuildTable( Tcl_HashTable *tablePtr) /* Table to enlarge. */ { int count, index, oldSize = tablePtr->numBuckets; Tcl_HashEntry **oldBuckets = tablePtr->buckets; Tcl_HashEntry **oldChainPtr, **newChainPtr; Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; /* Avoid outgrowing capability of the memory allocators */ if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) { tablePtr->rebuildSize = INT_MAX; return; } |
︙ | ︙ |
Changes to generic/tclHistory.c.
︙ | ︙ | |||
57 58 59 60 61 62 63 | * be executed. */ const char *cmd, /* Command to record. */ int flags) /* Additional flags. TCL_NO_EVAL means only * record: don't execute command. * TCL_EVAL_GLOBAL means use Tcl_GlobalEval * instead of Tcl_Eval. */ { | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | * be executed. */ const char *cmd, /* Command to record. */ int flags) /* Additional flags. TCL_NO_EVAL means only * record: don't execute command. * TCL_EVAL_GLOBAL means use Tcl_GlobalEval * instead of Tcl_Eval. */ { Tcl_Obj *cmdPtr; int result; if (cmd[0]) { /* * Call Tcl_RecordAndEvalObj to do the actual work. */ |
︙ | ︙ | |||
209 210 211 212 213 214 215 | */ static void DeleteHistoryObjs( ClientData clientData, Tcl_Interp *interp) { | | | 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | */ static void DeleteHistoryObjs( ClientData clientData, Tcl_Interp *interp) { HistoryObjs *histObjsPtr = clientData; TclDecrRefCount(histObjsPtr->historyObj); TclDecrRefCount(histObjsPtr->addObj); ckfree(histObjsPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
7476 7477 7478 7479 7480 7481 7482 | int bytesBuffered; for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } if (statePtr->curOutPtr != NULL) { | | | 7476 7477 7478 7479 7480 7481 7482 7483 7484 7485 7486 7487 7488 7489 7490 | int bytesBuffered; for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } if (statePtr->curOutPtr != NULL) { ChannelBuffer *curOutPtr = statePtr->curOutPtr; if (IsBufferReady(curOutPtr)) { bytesBuffered += BytesLeft(curOutPtr); } } return bytesBuffered; |
︙ | ︙ | |||
11231 11232 11233 11234 11235 11236 11237 | * representation. * *---------------------------------------------------------------------- */ static void DupChannelIntRep( | | | | 11231 11232 11233 11234 11235 11236 11237 11238 11239 11240 11241 11242 11243 11244 11245 11246 11247 | * representation. * *---------------------------------------------------------------------- */ static void DupChannelIntRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "Channel". */ Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { ResolvedChanName *resPtr; ChanGetIntRep(srcPtr, resPtr); assert(resPtr); ChanSetIntRep(copyPtr, resPtr); |
︙ | ︙ |
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
2121 2122 2123 2124 2125 2126 2127 | *---------------------------------------------------------------------- */ static Tcl_Obj * DecodeEventMask( int mask) { | | | 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 | *---------------------------------------------------------------------- */ static Tcl_Obj * DecodeEventMask( int mask) { const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { case RANDW: eventStr = "read write"; break; case TCL_READABLE: |
︙ | ︙ |
Changes to generic/tclIORTrans.c.
︙ | ︙ | |||
1702 1703 1704 1705 1706 1707 1708 | * DUPLICATE of 'DecodeEventMask' in tclIORChan.c */ static Tcl_Obj * DecodeEventMask( int mask) { | | | 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 | * DUPLICATE of 'DecodeEventMask' in tclIORChan.c */ static Tcl_Obj * DecodeEventMask( int mask) { const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { case RANDW: eventStr = "read write"; break; case TCL_READABLE: |
︙ | ︙ |
Changes to generic/tclIOSock.c.
︙ | ︙ | |||
26 27 28 29 30 31 32 | static const char * gai_strerror( int code) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->initialized) { | | > | | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | static const char * gai_strerror( int code) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->initialized) { Tcl_DStringSetLength(&tsdPtr->errorMsg, 0); } else { Tcl_DStringInit(&tsdPtr->errorMsg); tsdPtr->initialized = 1; } Tcl_WCharToUtfDString(gai_strerrorW(code), -1, &tsdPtr->errorMsg); return Tcl_DStringValue(&tsdPtr->errorMsg); } #endif /* *--------------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclIOUtil.c.
︙ | ︙ | |||
323 324 325 326 327 328 329 | oldStyleBuf->st_ino = (ino_t) buf.st_ino; oldStyleBuf->st_dev = buf.st_dev; oldStyleBuf->st_rdev = buf.st_rdev; oldStyleBuf->st_nlink = buf.st_nlink; oldStyleBuf->st_uid = buf.st_uid; oldStyleBuf->st_gid = buf.st_gid; oldStyleBuf->st_size = (off_t) buf.st_size; | | | | | 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 | oldStyleBuf->st_ino = (ino_t) buf.st_ino; oldStyleBuf->st_dev = buf.st_dev; oldStyleBuf->st_rdev = buf.st_rdev; oldStyleBuf->st_nlink = buf.st_nlink; oldStyleBuf->st_uid = buf.st_uid; oldStyleBuf->st_gid = buf.st_gid; oldStyleBuf->st_size = (off_t) buf.st_size; oldStyleBuf->st_atime = Tcl_GetAccessTimeFromStat(&buf); oldStyleBuf->st_mtime = Tcl_GetModificationTimeFromStat(&buf); oldStyleBuf->st_ctime = Tcl_GetChangeTimeFromStat(&buf); #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE oldStyleBuf->st_blksize = buf.st_blksize; #endif #ifdef HAVE_STRUCT_STAT_ST_BLOCKS #ifdef HAVE_BLKCNT_T oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks; #else |
︙ | ︙ | |||
1388 1389 1390 1391 1392 1393 1394 | Tcl_Obj *pathPtr, /* The path to normalize in place. */ int startAt) /* Start at this char-offset. */ { FilesystemRecord *fsRecPtr, *firstFsRecPtr; int i; int isVfsPath = 0; | | | 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 | Tcl_Obj *pathPtr, /* The path to normalize in place. */ int startAt) /* Start at this char-offset. */ { FilesystemRecord *fsRecPtr, *firstFsRecPtr; int i; int isVfsPath = 0; const char *path; /* * Paths starting with a UNC prefix whose final character is a colon * are reserved for VFS use. These names can not conflict with real * UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx * and rfc3986's definition of reg-name. * |
︙ | ︙ | |||
4418 4419 4420 4421 4422 4423 4424 | Tcl_Close(interp, out); /* * Set modification date of copied file. */ if (Tcl_FSLstat(source, &sourceStatBuf) == 0) { | | | | 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 | Tcl_Close(interp, out); /* * Set modification date of copied file. */ if (Tcl_FSLstat(source, &sourceStatBuf) == 0) { tval.actime = Tcl_GetAccessTimeFromStat(&sourceStatBuf); tval.modtime = Tcl_GetModificationTimeFromStat(&sourceStatBuf); Tcl_FSUtime(target, &tval); } done: return result; } |
︙ | ︙ |
Changes to generic/tclIndexObj.c.
︙ | ︙ | |||
422 423 424 425 426 427 428 | * *---------------------------------------------------------------------- */ static int SetIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 | * *---------------------------------------------------------------------- */ static int SetIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to index except via Tcl_GetIndexFromObj API", -1)); } return TCL_ERROR; |
︙ | ︙ | |||
454 455 456 457 458 459 460 | */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; | | | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 | */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; const char *indexStr = EXPAND_OF(indexRep); Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
963 964 965 966 967 968 969 | for (i=0 ; i<toPrint ; i++) { /* * Add the element, quoting it if necessary. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { | | | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 | for (i=0 ; i<toPrint ; i++) { /* * Add the element, quoting it if necessary. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { IndexRep *indexRep = irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { elementStr = TclGetStringFromObj(origObjv[i], &elemLen); } flags = 0; |
︙ | ︙ | |||
1012 1013 1014 1015 1016 1017 1018 | * If the object is an index type use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(objv[i], &indexType))) { | | | 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 | * If the object is an index type use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(objv[i], &indexType))) { IndexRep *indexRep = irPtr->twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). */ |
︙ | ︙ | |||
1103 1104 1105 1106 1107 1108 1109 | * processed here. Should be NULL if no return * of arguments is desired. */ { Tcl_Obj **leftovers; /* Array to write back to remObjv on * successful exit. Will include the name of * the command. */ int nrem; /* Size of leftovers.*/ | | | | 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 | * processed here. Should be NULL if no return * of arguments is desired. */ { Tcl_Obj **leftovers; /* Array to write back to remObjv on * successful exit. Will include the name of * the command. */ int nrem; /* Size of leftovers.*/ const Tcl_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ const Tcl_ArgvInfo *matchPtr; /* Descriptor that matches current argument */ Tcl_Obj *curArg; /* Current argument */ const char *str = NULL; char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ int srcIndex; /* Location from which to read next argument * from objv. */ int dstIndex; /* Used to keep track of current arguments * being processed, primarily for error |
︙ | ︙ | |||
1358 1359 1360 1361 1362 1363 1364 | PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ const Tcl_ArgvInfo *argTable) /* Array of command-specific argument * descriptions. */ { | | | 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 | PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ const Tcl_ArgvInfo *argTable) /* Array of command-specific argument * descriptions. */ { const Tcl_ArgvInfo *infoPtr; int width, numSpaces; #define NUM_SPACES 20 static const char spaces[] = " "; char tmp[TCL_DOUBLE_SPACE]; Tcl_Obj *msg; /* |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
74 75 76 77 78 79 80 | # include <stdlib.h> #endif #ifdef NO_STRING_H #include "../compat/string.h" #else #include <string.h> #endif | | | < < > > | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | # include <stdlib.h> #endif #ifdef NO_STRING_H #include "../compat/string.h" #else #include <string.h> #endif #if !defined(STDC_HEADERS) && !defined(__STDC__) && !defined(__C99__FUNC__) \ && !defined(__cplusplus) && !defined(_MSC_VER) && !defined(__ICC) typedef int ptrdiff_t; #endif #include <stddef.h> #include <locale.h> /* * Ensure WORDS_BIGENDIAN is defined correctly: * Needs to happen here in addition to configure to work with fat compiles on * Darwin (where configure runs only once for multiple architectures). */ |
︙ | ︙ | |||
1380 1381 1382 1383 1384 1385 1386 | void *data); /* * This is a convenience macro used to initialize a thread local storage ptr. */ #define TCL_TSD_INIT(keyPtr) \ | | | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 | void *data); /* * This is a convenience macro used to initialize a thread local storage ptr. */ #define TCL_TSD_INIT(keyPtr) \ (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) /* *---------------------------------------------------------------- * Data structures related to bytecode compilation and execution. These are * used primarily in tclCompile.c, tclExecute.c, and tclBasic.c. *---------------------------------------------------------------- */ |
︙ | ︙ | |||
2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 | * other than these should be turned into errors. */ #define TCL_ALLOW_EXCEPTIONS 0x04 #define TCL_EVAL_FILE 0x02 #define TCL_EVAL_SOURCE_IN_FRAME 0x10 #define TCL_EVAL_NORESOLVE 0x20 /* * Flag bits for Interp structures: * * DELETED: Non-zero means the interpreter has been deleted: * don't process any more commands for it, and destroy * the structure as soon as all nested invocations of | > | 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 | * other than these should be turned into errors. */ #define TCL_ALLOW_EXCEPTIONS 0x04 #define TCL_EVAL_FILE 0x02 #define TCL_EVAL_SOURCE_IN_FRAME 0x10 #define TCL_EVAL_NORESOLVE 0x20 #define TCL_EVAL_DISCARD_RESULT 0x40 /* * Flag bits for Interp structures: * * DELETED: Non-zero means the interpreter has been deleted: * don't process any more commands for it, and destroy * the structure as soon as all nested invocations of |
︙ | ︙ | |||
3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 | MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); | > | 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 | MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(int byte); MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); |
︙ | ︙ | |||
3238 3239 3240 3241 3242 3243 3244 | const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); MODULE_SCOPE void TclRegisterCommandTypeName( Tcl_ObjCmdProc *implementationProc, const char *nameStr); | < < < < < < < < < < < | 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 | const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); MODULE_SCOPE void TclRegisterCommandTypeName( Tcl_ObjCmdProc *implementationProc, const char *nameStr); MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCount(int ch); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, |
︙ | ︙ | |||
4230 4231 4232 4233 4234 4235 4236 | /* * DTrace object allocation probe macros. */ #ifdef USE_DTRACE #ifndef _TCLDTRACE_H | < | 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 | /* * DTrace object allocation probe macros. */ #ifdef USE_DTRACE #ifndef _TCLDTRACE_H #include "tclDTrace.h" #endif #define TCL_DTRACE_OBJ_CREATE(objPtr) TCL_OBJ_CREATE(objPtr) #define TCL_DTRACE_OBJ_FREE(objPtr) TCL_OBJ_FREE(objPtr) #else /* USE_DTRACE */ #define TCL_DTRACE_OBJ_CREATE(objPtr) {} #define TCL_DTRACE_OBJ_FREE(objPtr) {} |
︙ | ︙ | |||
4531 4532 4533 4534 4535 4536 4537 | * * MODULE_SCOPE void TclUnpackBignum(Tcl_Obj *objPtr, mp_int bignum); *---------------------------------------------------------------- */ #define TclUnpackBignum(objPtr, bignum) \ do { \ | | | | 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 | * * MODULE_SCOPE void TclUnpackBignum(Tcl_Obj *objPtr, mp_int bignum); *---------------------------------------------------------------- */ #define TclUnpackBignum(objPtr, bignum) \ do { \ Tcl_Obj *bignumObj = (objPtr); \ int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ } else { \ (bignum).dp = bignumObj->internalRep.twoPtrValue.ptr1; \ (bignum).sign = bignumPayload >> 30; \ (bignum).alloc = (bignumPayload >> 15) & 0x7fff; \ |
︙ | ︙ | |||
4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 | * 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); *---------------------------------------------------------------- */ #define TclUtfToUniChar(str, chPtr) \ ((((unsigned char) *(str)) < 0x80) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* *---------------------------------------------------------------- * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- * -sensitive points where it pays to avoid a function call in the common case * of counting along a string of all one-byte characters. The ANSI C * "prototype" for this macro is: | > > > > > > > | 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 | * 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 > 4 #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) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ : Tcl_UtfToChar16(str, chPtr)) #endif /* *---------------------------------------------------------------- * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- * -sensitive points where it pays to avoid a function call in the common case * of counting along a string of all one-byte characters. The ANSI C * "prototype" for this macro is: |
︙ | ︙ |
Changes to generic/tclInterp.c.
︙ | ︙ | |||
3287 3288 3289 3290 3291 3292 3293 | * place, but...) */ /* * No env array in a safe slave. */ | | | | | | 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 | * place, but...) */ /* * No env array in a safe slave. */ Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY); /* * Remove unsafe parts of tcl_platform */ Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY); Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY); Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY); Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY); /* * Unset path informations variables (the only one remaining is [info * nameofexecutable]) */ Tcl_UnsetVar2(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY); Tcl_UnsetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); Tcl_UnsetVar2(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); /* * Remove the standard channels from the interpreter; safe interpreters do * not ordinarily have access to stdin, stdout and stderr. * * NOTE: These channels are not added to the interpreter by the * Tcl_CreateInterp call, but may be added later, by another I/O |
︙ | ︙ | |||
3358 3359 3360 3361 3362 3363 3364 | *---------------------------------------------------------------------- */ int Tcl_LimitExceeded( Tcl_Interp *interp) { | | | 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 | *---------------------------------------------------------------------- */ int Tcl_LimitExceeded( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; return iPtr->limit.exceeded != 0; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
3389 3390 3391 3392 3393 3394 3395 | *---------------------------------------------------------------------- */ int Tcl_LimitReady( Tcl_Interp *interp) { | | | | 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 | *---------------------------------------------------------------------- */ int Tcl_LimitReady( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; if (iPtr->limit.active != 0) { int ticker = ++iPtr->limit.granularityTicker; if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) && ((iPtr->limit.cmdGranularity == 1) || (ticker % iPtr->limit.cmdGranularity == 0))) { return 1; } if ((iPtr->limit.active & TCL_LIMIT_TIME) && |
︙ | ︙ | |||
3436 3437 3438 3439 3440 3441 3442 | */ int Tcl_LimitCheck( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; | | | 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 | */ int Tcl_LimitCheck( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; int ticker = iPtr->limit.granularityTicker; if (Tcl_InterpDeleted(interp)) { return TCL_OK; } if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) && ((iPtr->limit.cmdGranularity == 1) || |
︙ | ︙ |
Changes to generic/tclListObj.c.
︙ | ︙ | |||
553 554 555 556 557 558 559 | * *---------------------------------------------------------------------- */ int Tcl_ListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 | * *---------------------------------------------------------------------- */ int Tcl_ListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object for which an element array is * to be returned. */ int *objcPtr, /* Where to store the count of objects * referenced by objv. */ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of * pointers to the list's objects. */ { List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result, length; (void) Tcl_GetStringFromObj(listPtr, &length); |
︙ | ︙ | |||
610 611 612 613 614 615 616 | * *---------------------------------------------------------------------- */ int Tcl_ListObjAppendList( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 | * *---------------------------------------------------------------------- */ int Tcl_ListObjAppendList( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append elements to. */ Tcl_Obj *elemListPtr) /* List obj with elements to append. */ { int objc; Tcl_Obj **objv; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList"); |
︙ | ︙ | |||
669 670 671 672 673 674 675 | int Tcl_ListObjAppendElement( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append objPtr to. */ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ { | | | 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 | int Tcl_ListObjAppendElement( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append objPtr to. */ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ { List *listRepPtr, *newPtr = NULL; int numElems, numRequired, needGrow, isShared, attempt; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement"); } ListGetIntRep(listPtr, listRepPtr); |
︙ | ︙ | |||
840 841 842 843 844 845 846 | * *---------------------------------------------------------------------- */ int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | | 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 | * *---------------------------------------------------------------------- */ int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to index into. */ int index, /* Index of element to return. */ Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ { List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result, length; (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { |
︙ | ︙ | |||
896 897 898 899 900 901 902 | * *---------------------------------------------------------------------- */ int Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | | 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 | * *---------------------------------------------------------------------- */ int Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object whose #elements to return. */ int *intPtr) /* The resulting int is stored here. */ { List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result, length; (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { |
︙ | ︙ | |||
970 971 972 973 974 975 976 | int first, /* Index of first element to replace. */ int count, /* Number of elements to replace. */ int objc, /* Number of objects to insert. */ Tcl_Obj *const objv[]) /* An array of objc pointers to Tcl objects to * insert. */ { List *listRepPtr; | | | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | int first, /* Index of first element to replace. */ int count, /* Number of elements to replace. */ int objc, /* Number of objects to insert. */ Tcl_Obj *const objv[]) /* An array of objc pointers to Tcl objects to * insert. */ { List *listRepPtr; Tcl_Obj **elemPtrs; int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } ListGetIntRep(listPtr, listRepPtr); |
︙ | ︙ |
Changes to generic/tclLiteral.c.
︙ | ︙ | |||
54 55 56 57 58 59 60 | * The literal table is made ready for use. * *---------------------------------------------------------------------- */ void TclInitLiteralTable( | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | * The literal table is made ready for use. * *---------------------------------------------------------------------- */ void TclInitLiteralTable( LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { #if (TCL_SMALL_HASH_TABLE != 4) Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable", TCL_SMALL_HASH_TABLE); #endif |
︙ | ︙ | |||
205 206 207 208 209 210 211 | * Literals should always have UTF-8 representations... but this * is not guaranteed so we need to be careful anyway. * * https://stackoverflow.com/q/54337750/301832 */ int objLength; | | | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | * Literals should always have UTF-8 representations... but this * is not guaranteed so we need to be careful anyway. * * https://stackoverflow.com/q/54337750/301832 */ int objLength; const char *objBytes = TclGetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) || ((objBytes[0] == bytes[0]) && (memcmp(objBytes, bytes, length) == 0)))) { /* * A literal was found: return it */ |
︙ | ︙ | |||
385 386 387 388 389 390 391 | *---------------------------------------------------------------------- */ int TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ | | | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 | *---------------------------------------------------------------------- */ int TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ int length, /* Number of bytes in the string. If < 0, the * string consists of all bytes up to the * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already * malloc'd bytes and ownership is passed to * this function. If LITERAL_CMD_NAME then * the literal should not be shared accross * namespaces. */ { CompileEnv *envPtr = ePtr; Interp *iPtr = envPtr->iPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; unsigned hash; unsigned int localHash; int objIndex, isNew; Namespace *nsPtr; if (length < 0) { length = (bytes ? strlen(bytes) : 0); } hash = HashString(bytes, length); |
︙ | ︙ | |||
458 459 460 461 462 463 464 | } /* * Is it in the interpreter's global literal table? If not, create it. */ globalPtr = NULL; | | | 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 | } /* * Is it in the interpreter's global literal table? If not, create it. */ globalPtr = NULL; objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &isNew, nsPtr, flags, &globalPtr); objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG if (globalPtr != NULL && globalPtr->refCount + 1 < 2) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclRegisterLiteral", (length>60? 60 : length), bytes, |
︙ | ︙ | |||
495 496 497 498 499 500 501 | *---------------------------------------------------------------------- */ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | | 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 | *---------------------------------------------------------------------- */ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *entryPtr; const char *bytes; int length, globalHash; bytes = TclGetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { |
︙ | ︙ | |||
541 542 543 544 545 546 547 | *---------------------------------------------------------------------- */ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 | *---------------------------------------------------------------------- */ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; unsigned int localHash; |
︙ | ︙ | |||
605 606 607 608 609 610 611 | * literal object. * *---------------------------------------------------------------------- */ int TclAddLiteralObj( | | | | 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | * literal object. * *---------------------------------------------------------------------- */ int TclAddLiteralObj( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The object to insert into the array. */ LiteralEntry **litPtrPtr) /* The location where the pointer to the new * literal entry should be stored. May be * NULL. */ { LiteralEntry *lPtr; int objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { ExpandLocalLiteralArray(envPtr); } objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; |
︙ | ︙ | |||
654 655 656 657 658 659 660 | * array of the CompileEnv's literal array if it becomes too large. * *---------------------------------------------------------------------- */ static int AddLocalLiteralEntry( | | | | 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 | * array of the CompileEnv's literal array if it becomes too large. * *---------------------------------------------------------------------- */ static int AddLocalLiteralEntry( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; int objIndex; objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr); /* * Add the literal to the local table. |
︙ | ︙ | |||
732 733 734 735 736 737 738 | * The local literal table is updated to refer to the new entries. * *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray( | | | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 | * The local literal table is updated to refer to the new entries. * *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray( CompileEnv *envPtr)/* Points to the CompileEnv whose object array * must be enlarged. */ { /* * The current allocated local literal entries are stored between elements * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ |
︙ | ︙ | |||
814 815 816 817 818 819 820 | *---------------------------------------------------------------------- */ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | | 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 | *---------------------------------------------------------------------- */ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr; LiteralEntry *entryPtr, *prevPtr; const char *bytes; int length; unsigned int index; if (iPtr == NULL) { goto done; } |
︙ | ︙ | |||
894 895 896 897 898 899 900 | * None. * *---------------------------------------------------------------------- */ static unsigned HashString( | | | | 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 | * None. * *---------------------------------------------------------------------- */ static unsigned HashString( const char *string, /* String for which to compute hash value. */ int length) /* Number of bytes in the string. */ { unsigned int result = 0; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose * the one below (multiply by 9 and add new character) because of the * following reasons: |
︙ | ︙ | |||
958 959 960 961 962 963 964 | * Memory gets reallocated and entries get rehashed into new buckets. * *---------------------------------------------------------------------- */ static void RebuildLiteralTable( | | | | | 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 | * Memory gets reallocated and entries get rehashed into new buckets. * *---------------------------------------------------------------------- */ static void RebuildLiteralTable( LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; LiteralEntry **oldChainPtr, **newChainPtr; LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; unsigned int oldSize, index; int count, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; |
︙ | ︙ | |||
1094 1095 1096 1097 1098 1099 1100 | LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 size_t count[NUM_COUNTERS]; int overflow; size_t i, j; double average, tmp; | | | 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 | LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 size_t count[NUM_COUNTERS]; int overflow; size_t i, j; double average, tmp; LiteralEntry *entryPtr; char *result, *p; /* * Compute a histogram of bucket usage. For each bucket chain i, j is the * number of entries in the chain. */ |
︙ | ︙ | |||
1165 1166 1167 1168 1169 1170 1171 | */ void TclVerifyLocalLiteralTable( CompileEnv *envPtr) /* Points to CompileEnv whose literal table is * to be validated. */ { | | | | 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 | */ void TclVerifyLocalLiteralTable( CompileEnv *envPtr) /* Points to CompileEnv whose literal table is * to be validated. */ { LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; char *bytes; size_t i, count; int length; count = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; |
︙ | ︙ | |||
1216 1217 1218 1219 1220 1221 1222 | */ void TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { | | | | 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 | */ void TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; char *bytes; size_t i, count; int length; count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; |
︙ | ︙ |
Changes to generic/tclMain.c.
︙ | ︙ | |||
66 67 68 69 70 71 72 | NewNativeObj( TCHAR *string, int length) { Tcl_DString ds; #ifdef UNICODE | | < < | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | NewNativeObj( TCHAR *string, int length) { Tcl_DString ds; #ifdef UNICODE Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(string, length, &ds); #else Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds); #endif return TclDStringToObj(&ds); } #endif /* !UNICODE || (TCL_UTF_MAX > 4) */ |
︙ | ︙ |
Changes to generic/tclNamesp.c.
︙ | ︙ | |||
236 237 238 239 240 241 242 | * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetCurrentNamespace( | | | 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 | * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetCurrentNamespace( Tcl_Interp *interp)/* Interpreter whose current namespace is * being queried. */ { return TclGetCurrentNamespace(interp); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
260 261 262 263 264 265 266 | * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetGlobalNamespace( | | | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetGlobalNamespace( Tcl_Interp *interp)/* Interpreter whose global namespace should * be returned. */ { return TclGetGlobalNamespace(interp); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
312 313 314 315 316 317 318 | * created in the frame. If 0, the frame is * for a "namespace eval" or "namespace * inscope" command and var references are * treated as references to namespace * variables. */ { Interp *iPtr = (Interp *) interp; | | | | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 | * created in the frame. If 0, the frame is * for a "namespace eval" or "namespace * inscope" command and var references are * treated as references to namespace * variables. */ { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = (CallFrame *) callFramePtr; Namespace *nsPtr; if (namespacePtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; /* |
︙ | ︙ | |||
389 390 391 392 393 394 395 | *---------------------------------------------------------------------- */ void Tcl_PopCallFrame( Tcl_Interp *interp) /* Interpreter with call frame to pop. */ { | | | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | *---------------------------------------------------------------------- */ void Tcl_PopCallFrame( Tcl_Interp *interp) /* Interpreter with call frame to pop. */ { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->framePtr; Namespace *nsPtr; /* * It's important to remove the call frame from the interpreter's stack of * call frames before deleting local variables, so that traces invoked by * the variable deletion don't see the partially-deleted frame. */ |
︙ | ︙ | |||
675 676 677 678 679 680 681 | ClientData clientData, /* One-word value to store with namespace. */ Tcl_NamespaceDeleteProc *deleteProc) /* Function called to delete client data when * the namespace is deleted. NULL if no * function should be called. */ { Interp *iPtr = (Interp *) interp; | | | 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 | ClientData clientData, /* One-word value to store with namespace. */ Tcl_NamespaceDeleteProc *deleteProc) /* Function called to delete client data when * the namespace is deleted. NULL if no * function should be called. */ { Interp *iPtr = (Interp *) interp; Namespace *nsPtr, *ancestorPtr; Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr; Namespace *globalNsPtr = iPtr->globalNsPtr; const char *simpleName; Tcl_HashEntry *entryPtr; Tcl_DString buffer1, buffer2; Tcl_DString *namePtr, *buffPtr; int newEntry, nameLen; |
︙ | ︙ | |||
844 845 846 847 848 849 850 | Tcl_DStringInit(&buffer1); Tcl_DStringInit(&buffer2); namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { | | | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 | Tcl_DStringInit(&buffer1); Tcl_DStringInit(&buffer2); namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { Tcl_DString *tempPtr = namePtr; TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); TclDStringAppendDString(buffPtr, namePtr); /* * Clear the unwanted buffer or we end up appending to previous |
︙ | ︙ | |||
918 919 920 921 922 923 924 | *---------------------------------------------------------------------- */ void Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { | | | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 | *---------------------------------------------------------------------- */ void Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace((Tcl_Interp *) iPtr); Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr; |
︙ | ︙ | |||
1114 1115 1116 1117 1118 1119 1120 | * Deletes all commands, variables and namespaces in this namespace. * *---------------------------------------------------------------------- */ void TclTeardownNamespace( | | | | 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 | * Deletes all commands, variables and namespaces in this namespace. * *---------------------------------------------------------------------- */ void TclTeardownNamespace( Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; int i; /* * Start by destroying the namespace's variable table, since variables * might trigger traces. Variable table should be cleared but not freed! * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards. |
︙ | ︙ | |||
1307 1308 1309 1310 1311 1312 1313 | * None. * *---------------------------------------------------------------------- */ static void NamespaceFree( | | | 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 | * None. * *---------------------------------------------------------------------- */ static void NamespaceFree( Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is * deleted by Tcl_DeleteNamespace. All that remains is to free its names * (for error messages), and the structure itself. */ |
︙ | ︙ | |||
1582 1583 1584 1585 1586 1587 1588 | int allowOverwrite) /* If nonzero, allow existing commands to be * overwritten by imported commands. If 0, * return an error if an imported cmd * conflicts with an existing one. */ { Namespace *nsPtr, *importNsPtr, *dummyPtr; const char *simplePattern; | | | 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 | int allowOverwrite) /* If nonzero, allow existing commands to be * overwritten by imported commands. If 0, * return an error if an imported cmd * conflicts with an existing one. */ { Namespace *nsPtr, *importNsPtr, *dummyPtr; const char *simplePattern; Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { |
︙ | ︙ | |||
1861 1862 1863 1864 1865 1866 1867 | * removed. NULL for current namespace. */ const char *pattern) /* String pattern indicating which imported * commands to remove. */ { Namespace *nsPtr, *sourceNsPtr, *dummyPtr; const char *simplePattern; char *cmdName; | | | 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 | * removed. NULL for current namespace. */ const char *pattern) /* String pattern indicating which imported * commands to remove. */ { Namespace *nsPtr, *sourceNsPtr, *dummyPtr; const char *simplePattern; char *cmdName; Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { |
︙ | ︙ | |||
1988 1989 1990 1991 1992 1993 1994 | */ Tcl_Command TclGetOriginalCommand( Tcl_Command command) /* The imported command for which the original * command should be returned. */ { | | | 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 | */ Tcl_Command TclGetOriginalCommand( Tcl_Command command) /* The imported command for which the original * command should be returned. */ { Command *cmdPtr = (Command *) command; ImportedCmdData *dataPtr; if (cmdPtr->deleteProc != DeleteImportedCmd) { return NULL; } while (cmdPtr->deleteProc == DeleteImportedCmd) { |
︙ | ︙ | |||
2077 2078 2079 2080 2081 2082 2083 | DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; | | | 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 | DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; ImportRef *refPtr, *prevPtr; prevPtr = NULL; for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL; refPtr = refPtr->nextPtr) { if (refPtr->importedCmdPtr == selfPtr) { /* * Remove *refPtr from real command's list of imported commands |
︙ | ︙ | |||
2497 2498 2499 2500 2501 2502 2503 | * (current namespace if contextNsPtr is * NULL), then in global namespace. */ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or * if the name starts with "::". Otherwise, * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ | | | 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 | * (current namespace if contextNsPtr is * NULL), then in global namespace. */ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or * if the name starts with "::". Otherwise, * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; const char *dummy; /* |
︙ | ︙ | |||
2568 2569 2570 2571 2572 2573 2574 | * namespace if contextNsPtr is NULL), and * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY * and TCL_NAMESPACE_ONLY are given, * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; Namespace *cxtNsPtr; | | | | 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 | * namespace if contextNsPtr is NULL), and * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY * and TCL_NAMESPACE_ONLY are given, * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; Namespace *cxtNsPtr; Tcl_HashEntry *entryPtr; Command *cmdPtr; const char *simpleName; int result; /* * If this namespace has a command resolver, then give it first crack at * the command resolution. If the interpreter has any command resolvers, * consult them next. The command resolver functions may return a |
︙ | ︙ | |||
2680 2681 2682 2683 2684 2685 2686 | if (entryPtr != NULL) { cmdPtr = Tcl_GetHashValue(entryPtr); } } } } else { Namespace *nsPtr[2]; | | | 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 | if (entryPtr != NULL) { cmdPtr = Tcl_GetHashValue(entryPtr); } } } } else { Namespace *nsPtr[2]; int search; TclGetNamespaceForQualName(interp, name, cxtNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /* * Look for the command in the command table of its namespace. Be sure * to check both possible search paths: from the specified namespace |
︙ | ︙ | |||
2754 2755 2756 2757 2758 2759 2760 | void TclResetShadowedCmdRefs( Tcl_Interp *interp, /* Interpreter containing the new command. */ Command *newCmdPtr) /* Points to the new command. */ { char *cmdName; Tcl_HashEntry *hPtr; | | | 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 | void TclResetShadowedCmdRefs( Tcl_Interp *interp, /* Interpreter containing the new command. */ Command *newCmdPtr) /* Points to the new command. */ { char *cmdName; Tcl_HashEntry *hPtr; Namespace *nsPtr; Namespace *trailNsPtr, *shadowNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); int found, i; int trailFront = -1; int trailSize = 5; /* Formerly NUM_TRAIL_ELEMS. */ Namespace **trailPtr = TclStackAlloc(interp, trailSize * sizeof(Namespace *)); |
︙ | ︙ | |||
3004 3005 3006 3007 3008 3009 3010 | Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; Namespace *nsPtr, *childNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); const char *pattern = NULL; Tcl_DString buffer; | | | 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 | Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; Namespace *nsPtr, *childNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); const char *pattern = NULL; Tcl_DString buffer; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Tcl_Obj *listPtr, *elemPtr; /* * Get a pointer to the specified namespace, or the current namespace. */ |
︙ | ︙ | |||
3130 3131 3132 3133 3134 3135 3136 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; | | | 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; const char *arg; int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); return TCL_ERROR; } |
︙ | ︙ | |||
3209 3210 3211 3212 3213 3214 3215 | static int NamespaceCurrentCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 | static int NamespaceCurrentCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } /* |
︙ | ︙ | |||
3274 3275 3276 3277 3278 3279 3280 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; const char *name; | | | 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; const char *name; int i; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?name name...?"); return TCL_ERROR; } /* |
︙ | ︙ | |||
3629 3630 3631 3632 3633 3634 3635 | NamespaceForgetCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *pattern; | | | 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 | NamespaceForgetCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *pattern; int i, result; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?"); return TCL_ERROR; } for (i = 1; i < objc; i++) { |
︙ | ︙ | |||
3695 3696 3697 3698 3699 3700 3701 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int allowOverwrite = 0; const char *string, *pattern; | | | 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int allowOverwrite = 0; const char *string, *pattern; int i, result; int firstArg; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?"); return TCL_ERROR; } |
︙ | ︙ | |||
3848 3849 3850 3851 3852 3853 3854 | * of extra arguments to form the command to evaluate. */ if (objc == 3) { cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; | | | 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 | * of extra arguments to form the command to evaluate. */ if (objc == 3) { cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); for (i = 3; i < objc; i++) { if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){ Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */ return TCL_ERROR; } |
︙ | ︙ | |||
4249 4250 4251 4252 4253 4254 4255 | static int NamespaceQualifiersCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 | static int NamespaceQualifiersCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *p; int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } |
︙ | ︙ | |||
4504 4505 4506 4507 4508 4509 4510 | static int NamespaceTailCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 | static int NamespaceTailCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *p; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } /* |
︙ | ︙ | |||
4707 4708 4709 4710 4711 4712 4713 | * the namespace, it's structure will be freed. * *---------------------------------------------------------------------- */ static void FreeNsNameInternalRep( | | | 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 | * the namespace, it's structure will be freed. * *---------------------------------------------------------------------- */ static void FreeNsNameInternalRep( Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr; NsNameGetIntRep(objPtr, resNamePtr); assert(resNamePtr != NULL); |
︙ | ︙ | |||
4754 4755 4756 4757 4758 4759 4760 | * *---------------------------------------------------------------------- */ static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ | | | 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 | * *---------------------------------------------------------------------- */ static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr; NsNameGetIntRep(srcPtr, resNamePtr); assert(resNamePtr != NULL); NsNameSetIntRep(copyPtr, resNamePtr); } |
︙ | ︙ | |||
4790 4791 4792 4793 4794 4795 4796 | */ static int SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ | | | | 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 | */ static int SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; ResolvedNsName *resNamePtr; const char *name; if (interp == NULL) { return TCL_ERROR; } name = TclGetString(objPtr); |
︙ | ︙ | |||
4917 4918 4919 4920 4921 4922 4923 | * the error. */ int length, /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ { | | | 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 | * the error. */ int length, /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ { const char *p; Interp *iPtr = (Interp *) interp; int overflow, limit = 150; Var *varPtr, *arrayPtr; if (iPtr->flags & ERR_ALREADY_LOGGED) { /* * Someone else has already logged error information for this command; |
︙ | ︙ |
Changes to generic/tclOO.c.
︙ | ︙ | |||
785 786 787 788 789 790 791 | */ static void MyDeleted( ClientData clientData) /* Reference to the object whose [my] has been * squelched. */ { | | | 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 | */ static void MyDeleted( ClientData clientData) /* Reference to the object whose [my] has been * squelched. */ { Object *oPtr = clientData; oPtr->myCommand = NULL; } static void MyClassDeleted( ClientData clientData) |
︙ | ︙ | |||
1648 1649 1650 1651 1652 1653 1654 | * unique name. */ int objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip) /* Number of arguments to _not_ pass to the * constructor. */ { | | | 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 | * unique name. */ int objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; Object *oPtr; ClientData clientData[4]; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) { return NULL; } |
︙ | ︙ | |||
1718 1719 1720 1721 1722 1723 1724 | * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { | | | 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 | * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { Class *classPtr = (Class *) cls; CallContext *contextPtr; Tcl_InterpState state; Object *oPtr; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) { return TCL_ERROR; |
︙ | ︙ | |||
2652 2653 2654 2655 2656 2657 2658 | /* * Give plugged in code a chance to remap the method name. */ methodNamePtr = objv[1]; if (oPtr->mapMethodNameProc != NULL) { | | | 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 | /* * Give plugged in code a chance to remap the method name. */ methodNamePtr = objv[1]; if (oPtr->mapMethodNameProc != NULL) { Class **startClsPtr = &startCls; Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr); result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr, (Tcl_Class *) startClsPtr, mappedMethodName); if (result != TCL_OK) { TclDecrRefCount(mappedMethodName); if (result == TCL_BREAK) { |
︙ | ︙ | |||
2711 2712 2713 2714 2715 2716 2717 | * Check to see if we need to apply magical tricks to start part way * through the call chain. */ if (startCls != NULL) { for (; contextPtr->index < contextPtr->callPtr->numChain; contextPtr->index++) { | | | 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 | * Check to see if we need to apply magical tricks to start part way * through the call chain. */ if (startCls != NULL) { for (; contextPtr->index < contextPtr->callPtr->numChain; contextPtr->index++) { struct MInvoke *miPtr = &contextPtr->callPtr->chain[contextPtr->index]; if (miPtr->isFilter) { continue; } if (miPtr->mPtr->declaringClassPtr == startCls) { break; |
︙ | ︙ | |||
2849 2850 2851 2852 2853 2854 2855 | TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { | | | 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 | TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { CallContext *contextPtr = (CallContext *) context; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless the * interpreter is being torn down, in which case we might be getting * here because of methods/destructors doing a [next] (or equivalent) * unexpectedly. |
︙ | ︙ |
Changes to generic/tclOOBasic.c.
︙ | ︙ | |||
422 423 424 425 426 427 428 | * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { CallContext *contextPtr = (CallContext *) context; Tcl_Object object = Tcl_ObjectContextObject(context); | | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 | * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { CallContext *contextPtr = (CallContext *) context; Tcl_Object object = Tcl_ObjectContextObject(context); const int skip = Tcl_ObjectContextSkippedArgs(context); CallFrame *framePtr, **framePtrPtr = &framePtr; Tcl_Obj *scriptPtr; CmdFrame *invoker; if (objc-1 < skip) { Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?"); return TCL_ERROR; |
︙ | ︙ | |||
1118 1119 1120 1121 1122 1123 1124 | case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { | | | 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 | case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); Object *oPtr; const char *type; if (miPtr->filterDeclarer != NULL) { oPtr = miPtr->filterDeclarer->thisPtr; type = "class"; } else { |
︙ | ︙ |
Changes to generic/tclOOCall.c.
︙ | ︙ | |||
164 165 166 167 168 169 170 | * ---------------------------------------------------------------------- */ void TclOODeleteContext( CallContext *contextPtr) { | | | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | * ---------------------------------------------------------------------- */ void TclOODeleteContext( CallContext *contextPtr) { Object *oPtr = contextPtr->oPtr; TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { TclStackFree(oPtr->fPtr->interp, contextPtr); /* * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore |
︙ | ︙ | |||
310 311 312 313 314 315 316 | Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method * implementation. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { | | | 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 | Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method * implementation. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { CallContext *const contextPtr = clientData; Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const int isFilter = contextPtr->callPtr->chain[contextPtr->index].isFilter; /* * If this is the first step along the chain, we preserve the method * entries in the chain so that they do not get deleted out from under our |
︙ | ︙ | |||
964 965 966 967 968 969 970 | int flags) /* Used to check if we're mixin-consistent * only. Mixin-consistent means that either * we're looking to add things from a mixin * and we have passed a mixin, or we're not * looking to add things from a mixin and have * not passed a mixin. */ { | | | 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 | int flags) /* Used to check if we're mixin-consistent * only. Mixin-consistent means that either * we're looking to add things from a mixin * and we have passed a mixin, or we're not * looking to add things from a mixin and have * not passed a mixin. */ { CallChain *callPtr = cbPtr->callChainPtr; int i; /* * Return if this is just an entry used to record whether this is a public * method. If so, there's nothing real to call and so nothing to add to * the call chain. * |
︙ | ︙ | |||
1652 1653 1654 1655 1656 1657 1658 | } if (classPtr == contextCls) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodName); if (hPtr != NULL) { | | | 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 | } if (classPtr == contextCls) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodName); if (hPtr != NULL) { Method *mPtr = Tcl_GetHashValue(hPtr); if (IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); return 1; } } |
︙ | ︙ | |||
1736 1737 1738 1739 1740 1741 1742 | Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj); if (classPtr->flags & HAS_PRIVATE_METHODS) { privateDanger |= 1; } if (hPtr != NULL) { | | | 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 | Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj); if (classPtr->flags & HAS_PRIVATE_METHODS) { privateDanger |= 1; } if (hPtr != NULL) { Method *mPtr = Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { if (!(flags & KNOWN_STATE)) { if (flags & PUBLIC_METHOD) { if (!IS_PUBLIC(mPtr)) { return privateDanger; } |
︙ | ︙ |
Changes to generic/tclOODefineCmds.c.
︙ | ︙ | |||
775 776 777 778 779 780 781 | FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { int length; const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); | | | 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 | FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { int length; const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; Tcl_Command cmd, cmd2; /* * If someone is playing games, we stop playing right now. */ |
︙ | ︙ | |||
1240 1241 1242 1243 1244 1245 1246 | ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Namespace *nsPtr; Object *oPtr; | | | | | 1240 1241 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 1277 | ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Namespace *nsPtr; Object *oPtr; int result, isPrivate; oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (objc < 2) { Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr)); return TCL_OK; } isPrivate = IsPrivateDefine(interp); /* * Make the oo::objdefine namespace the current namespace and evaluate the * command(s). */ nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0); if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) { return TCL_ERROR; } if (isPrivate) { ((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME; } AddRef(oPtr); if (objc == 2) { Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr); |
︙ | ︙ |
Changes to generic/tclOOInfo.c.
︙ | ︙ | |||
805 806 807 808 809 810 811 | ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; Tcl_Obj *resultObj; | | | | | 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 | ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; Tcl_Obj *resultObj; int i, isPrivate = 0; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?"); return TCL_ERROR; } if (objc == 3) { if (strcmp("-private", Tcl_GetString(objv[2])) != 0) { return TCL_ERROR; } isPrivate = 1; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } resultObj = Tcl_NewObj(); if (isPrivate) { PrivateVariableMapping *privatePtr; FOREACH_STRUCT(privatePtr, oPtr->privateVariables) { Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj); } } else { Tcl_Obj *variableObj; |
︙ | ︙ | |||
1584 1585 1586 1587 1588 1589 1590 | ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr; Tcl_Obj *resultObj; | | | | | 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 | ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr; Tcl_Obj *resultObj; int i, isPrivate = 0; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?"); return TCL_ERROR; } if (objc == 3) { if (strcmp("-private", Tcl_GetString(objv[2])) != 0) { return TCL_ERROR; } isPrivate = 1; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } resultObj = Tcl_NewObj(); if (isPrivate) { PrivateVariableMapping *privatePtr; FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) { Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj); } } else { Tcl_Obj *variableObj; |
︙ | ︙ |
Changes to generic/tclOOInt.h.
︙ | ︙ | |||
667 668 669 670 671 672 673 | * Convenience macro for duplicating a list. Needs no external declaration, * but all arguments are used multiple times and so must have no side effects. */ #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ #define DUPLICATE(target,source,type) \ do { \ | | | 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 | * Convenience macro for duplicating a list. Needs no external declaration, * but all arguments are used multiple times and so must have no side effects. */ #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ #define DUPLICATE(target,source,type) \ do { \ size_t len = sizeof(type) * ((target).num=(source).num);\ if (len != 0) { \ memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \ } else { \ (target).list = NULL; \ } \ } while(0) |
︙ | ︙ |
Changes to generic/tclOOMethod.c.
︙ | ︙ | |||
145 146 147 148 149 150 151 | const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { | | | | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { Object *oPtr = (Object *) object; Method *mPtr; Tcl_HashEntry *hPtr; int isNew; if (nameObj == NULL) { mPtr = ckalloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; |
︙ | ︙ | |||
217 218 219 220 221 222 223 | const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { | | | | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 | const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { Class *clsPtr = (Class *) cls; Method *mPtr; Tcl_HashEntry *hPtr; int isNew; if (nameObj == NULL) { mPtr = ckalloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; |
︙ | ︙ | |||
340 341 342 343 344 345 346 | * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; | | | 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 | * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; ProcedureMethod *pmPtr; Tcl_Method method; if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } pmPtr = ckalloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); |
︙ | ︙ | |||
392 393 394 395 396 397 398 | * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; /* -1 => delete argsObj before exit */ | | | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; /* -1 => delete argsObj before exit */ ProcedureMethod *pmPtr; const char *procName; Tcl_Method method; if (argsObj == NULL) { argsLen = -1; argsObj = Tcl_NewObj(); Tcl_IncrRefCount(argsObj); |
︙ | ︙ | |||
792 793 794 795 796 797 798 | * method. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv, /* Array of arguments. */ PMFrameData *fdPtr) /* Place to store information about the call * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; | | | 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 | * method. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv, /* Array of arguments. */ PMFrameData *fdPtr) /* Place to store information about the call * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; int result; const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; ByteCode *codePtr; /* * Compute basic information on the basis of the type of method it is. */ |
︙ | ︙ | |||
825 826 827 828 829 830 831 | /* * Magic to enable things like [incr Tcl], which wants methods to run in * their class's namespace. */ if (pmPtr->flags & USE_DECLARER_NS) { | | | 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 | /* * Magic to enable things like [incr Tcl], which wants methods to run in * their class's namespace. */ if (pmPtr->flags & USE_DECLARER_NS) { Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { nsPtr = (Namespace *) mPtr->declaringClassPtr->thisPtr->namespacePtr; } else { nsPtr = (Namespace *) mPtr->declaringObjectPtr->namespacePtr; |
︙ | ︙ | |||
896 897 898 899 900 901 902 | fdPtr->efi.fields[0].proc = NULL; fdPtr->efi.fields[0].clientData = fdPtr->nameObj; if (pmPtr->gfivProc != NULL) { fdPtr->efi.fields[1].name = ""; fdPtr->efi.fields[1].proc = pmPtr->gfivProc; fdPtr->efi.fields[1].clientData = pmPtr; } else { | | | 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 | fdPtr->efi.fields[0].proc = NULL; fdPtr->efi.fields[0].clientData = fdPtr->nameObj; if (pmPtr->gfivProc != NULL) { fdPtr->efi.fields[1].name = ""; fdPtr->efi.fields[1].proc = pmPtr->gfivProc; fdPtr->efi.fields[1].clientData = pmPtr; } else { Tcl_Method method = Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr); if (Tcl_MethodDeclarerObject(method) != NULL) { fdPtr->efi.fields[1].name = "object"; } else { fdPtr->efi.fields[1].name = "class"; } |
︙ | ︙ | |||
1290 1291 1292 1293 1294 1295 1296 | ckfree(pmPtr); } static void DeleteProcedureMethod( void *clientData) { | | | 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 | ckfree(pmPtr); } static void DeleteProcedureMethod( void *clientData) { ProcedureMethod *pmPtr = clientData; if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } } static int |
︙ | ︙ | |||
1383 1384 1385 1386 1387 1388 1389 | Object *oPtr, /* The object to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; | | | 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 | Object *oPtr, /* The object to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "method forward prefix must be non-empty", -1)); |
︙ | ︙ | |||
1422 1423 1424 1425 1426 1427 1428 | Class *clsPtr, /* The class to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; | | | 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 | Class *clsPtr, /* The class to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "method forward prefix must be non-empty", -1)); |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
807 808 809 810 811 812 813 | } /* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- * | | | 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 | } /* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- * * This function is called to a new Tcl object type in the table * of all object types supported by Tcl. * * Results: * None. * * Side effects: * The type is registered in the Tcl type table. If there was already a |
︙ | ︙ | |||
866 867 868 869 870 871 872 | int Tcl_AppendAllObjTypes( Tcl_Interp *interp, /* Interpreter used for error reporting. */ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the * name of each registered type is appended as * a list element. */ { | | | 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 | int Tcl_AppendAllObjTypes( Tcl_Interp *interp, /* Interpreter used for error reporting. */ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the * name of each registered type is appended as * a list element. */ { Tcl_HashEntry *hPtr; Tcl_HashSearch search; int numElems; /* * Get the test for a valid list out of the way first. */ |
︙ | ︙ | |||
914 915 916 917 918 919 920 | *---------------------------------------------------------------------- */ const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { | | | 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 | *---------------------------------------------------------------------- */ const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { Tcl_HashEntry *hPtr; const Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typeName); if (hPtr != NULL) { typePtr = Tcl_GetHashValue(hPtr); } |
︙ | ︙ | |||
1044 1045 1046 1047 1048 1049 1050 | * None. *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( | | | | | 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 | * None. *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( Tcl_Obj *objPtr, const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { objPtr->refCount = 0; objPtr->typePtr = NULL; TclInitStringRep(objPtr, NULL, 0); #if TCL_THREADS |
︙ | ︙ | |||
1131 1132 1133 1134 1135 1136 1137 | } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewObj(void) { | | | 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 | } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewObj(void) { Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. */ TclNewObj(objPtr); return objPtr; |
︙ | ︙ | |||
1173 1174 1175 1176 1177 1178 1179 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj( | | | | | 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj( const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. */ TclDbNewObj(objPtr, file, line); return objPtr; |
︙ | ︙ | |||
1228 1229 1230 1231 1232 1233 1234 | #define OBJS_TO_ALLOC_EACH_TIME 100 void TclAllocateFreeObjects(void) { size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); char *basePtr; | | | | 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 | #define OBJS_TO_ALLOC_EACH_TIME 100 void TclAllocateFreeObjects(void) { size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); char *basePtr; Tcl_Obj *prevPtr, *objPtr; int i; /* * This has been noted by Purify to be a potential leak. The problem is * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually * freeing the memory. TclFinalizeObjects() does not ckfree() this memory, * but leaves it to Tcl's memory subsystem finalization to release it. |
︙ | ︙ | |||
1280 1281 1282 1283 1284 1285 1286 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclFreeObj( | | | | 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclFreeObj( Tcl_Obj *objPtr) /* The object to be freed. */ { const Tcl_ObjType *typePtr = objPtr->typePtr; /* * This macro declares a variable, so must come here... */ ObjInitDeletionContext(context); |
︙ | ︙ | |||
1405 1406 1407 1408 1409 1410 1411 | } } } #else /* TCL_MEM_DEBUG */ void TclFreeObj( | | | 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 | } } } #else /* TCL_MEM_DEBUG */ void TclFreeObj( Tcl_Obj *objPtr) /* The object to be freed. */ { /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) * with 'length == -1'. */ |
︙ | ︙ | |||
1614 1615 1616 1617 1618 1619 1620 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetString( | | | 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetString( Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes == NULL) { /* * Note we do not check for objPtr->typePtr == NULL. An invariant * of a properly maintained Tcl_Obj is that at least one of * objPtr->bytes and objPtr->typePtr must not be NULL. If broken |
︙ | ︙ | |||
1670 1671 1672 1673 1674 1675 1676 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetStringFromObj( | | | | 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ int *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { if (objPtr->bytes == NULL) { /* * Note we do not check for objPtr->typePtr == NULL. An invariant * of a properly maintained Tcl_Obj is that at least one of |
︙ | ︙ | |||
1812 1813 1814 1815 1816 1817 1818 | * the string representation NULL to mark it invalid. * *---------------------------------------------------------------------- */ void Tcl_InvalidateStringRep( | | | 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 | * the string representation NULL to mark it invalid. * *---------------------------------------------------------------------- */ void Tcl_InvalidateStringRep( Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be freed. */ { TclInvalidateStringRep(objPtr); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1957 1958 1959 1960 1961 1962 1963 | */ #undef Tcl_NewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewBooleanObj( | | | | | 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 | */ #undef Tcl_NewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewBooleanObj( int boolValue) /* Boolean used to initialize new object. */ { return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewBooleanObj( int boolValue) /* Boolean used to initialize new object. */ { Tcl_Obj *objPtr; TclNewIntObj(objPtr, boolValue!=0); return objPtr; } #endif /* TCL_MEM_DEBUG */ /* |
︙ | ︙ | |||
2007 2008 2009 2010 2011 2012 2013 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBooleanObj( | | | | | 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBooleanObj( int boolValue, /* Boolean used to initialize new object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; objPtr->internalRep.wideValue = (boolValue != 0); objPtr->typePtr = &tclIntType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewBooleanObj( int boolValue, /* Boolean used to initialize new object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewBooleanObj(boolValue); } |
︙ | ︙ | |||
2059 2060 2061 2062 2063 2064 2065 | * *---------------------------------------------------------------------- */ #undef Tcl_SetBooleanObj void Tcl_SetBooleanObj( | | | | 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 | * *---------------------------------------------------------------------- */ #undef Tcl_SetBooleanObj void Tcl_SetBooleanObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ int boolValue) /* Boolean used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); } TclSetIntObj(objPtr, boolValue!=0); } |
︙ | ︙ | |||
2092 2093 2094 2095 2096 2097 2098 | * *---------------------------------------------------------------------- */ int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 | * *---------------------------------------------------------------------- */ int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get boolean. */ int *boolPtr) /* Place to store resulting boolean. */ { do { if (objPtr->typePtr == &tclIntType) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } if (objPtr->typePtr == &tclBooleanType) { |
︙ | ︙ | |||
2158 2159 2160 2161 2162 2163 2164 | * *---------------------------------------------------------------------- */ int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 | * *---------------------------------------------------------------------- */ int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine * whether a boolean conversion is possible without generating the string * rep. */ |
︙ | ︙ | |||
2204 2205 2206 2207 2208 2209 2210 | Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL); } return TCL_ERROR; } static int ParseBoolean( | | | 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 | Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL); } return TCL_ERROR; } static int ParseBoolean( Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; const char *str = TclGetString(objPtr); size_t i, length = objPtr->length; if ((length == 0) || (length > 5)) { |
︙ | ︙ | |||
2346 2347 2348 2349 2350 2351 2352 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewDoubleObj Tcl_Obj * Tcl_NewDoubleObj( | | | | | 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewDoubleObj Tcl_Obj * Tcl_NewDoubleObj( double dblValue) /* Double used to initialize the object. */ { return Tcl_DbNewDoubleObj(dblValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewDoubleObj( double dblValue) /* Double used to initialize the object. */ { Tcl_Obj *objPtr; TclNewDoubleObj(objPtr, dblValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ /* |
︙ | ︙ | |||
2394 2395 2396 2397 2398 2399 2400 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDoubleObj( | | | | | 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDoubleObj( double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; objPtr->internalRep.doubleValue = dblValue; objPtr->typePtr = &tclDoubleType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewDoubleObj( double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewDoubleObj(dblValue); } |
︙ | ︙ | |||
2445 2446 2447 2448 2449 2450 2451 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetDoubleObj( | | | | 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetDoubleObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ double dblValue) /* Double used to set the object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj"); } TclSetDoubleObj(objPtr, dblValue); } |
︙ | ︙ | |||
2478 2479 2480 2481 2482 2483 2484 | * *---------------------------------------------------------------------- */ int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 | * *---------------------------------------------------------------------- */ int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a double. */ double *dblPtr) /* Place to store resulting double. */ { do { if (objPtr->typePtr == &tclDoubleType) { if (TclIsNaN(objPtr->internalRep.doubleValue)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); |
︙ | ︙ | |||
2533 2534 2535 2536 2537 2538 2539 | * *---------------------------------------------------------------------- */ static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 | * *---------------------------------------------------------------------- */ static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1, NULL, 0); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
2562 2563 2564 2565 2566 2567 2568 | * double-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfDouble( | | | 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 | * double-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfDouble( Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); TclOOM(dst, TCL_DOUBLE_SPACE + 1); Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); |
︙ | ︙ | |||
2608 2609 2610 2611 2612 2613 2614 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewIntObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewIntObj( | | | | | 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewIntObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewIntObj( int intValue) /* Int used to initialize the new object. */ { return Tcl_DbNewWideIntObj((long)intValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewIntObj( int intValue) /* Int used to initialize the new object. */ { Tcl_Obj *objPtr; TclNewIntObj(objPtr, intValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ #endif /* TCL_NO_DEPRECATED */ |
︙ | ︙ | |||
2648 2649 2650 2651 2652 2653 2654 | * *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_SetIntObj void Tcl_SetIntObj( | | | | 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 | * *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_SetIntObj void Tcl_SetIntObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ int intValue) /* Integer used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); } TclSetIntObj(objPtr, intValue); } |
︙ | ︙ | |||
2688 2689 2690 2691 2692 2693 2694 | * *---------------------------------------------------------------------- */ int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 | * *---------------------------------------------------------------------- */ int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a int. */ int *intPtr) /* Place to store resulting int. */ { #if (LONG_MAX == INT_MAX) return TclGetLongFromObj(interp, objPtr, (long *) intPtr); #else long l; if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) { |
︙ | ︙ | |||
2759 2760 2761 2762 2763 2764 2765 | * int-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfInt( | | | | 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 | * int-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfInt( Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); TclOOM(dst, TCL_INTEGER_SPACE + 1); (void) Tcl_InitStringRep(objPtr, NULL, TclFormatInt(dst, objPtr->internalRep.wideValue)); } #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) static void UpdateStringOfOldInt( Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); TclOOM(dst, TCL_INTEGER_SPACE + 1); (void) Tcl_InitStringRep(objPtr, NULL, TclFormatInt(dst, objPtr->internalRep.longValue)); } |
︙ | ︙ | |||
2817 2818 2819 2820 2821 2822 2823 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewLongObj( | | | | | 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewLongObj( long longValue) /* Long integer used to initialize the * new object. */ { return Tcl_DbNewWideIntObj(longValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewLongObj( long longValue) /* Long integer used to initialize the * new object. */ { Tcl_Obj *objPtr; TclNewIntObj(objPtr, longValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ #endif /* TCL_NO_DEPRECATED */ |
︙ | ︙ | |||
2876 2877 2878 2879 2880 2881 2882 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewLongObj( | | | | | 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewLongObj( long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep */ objPtr->bytes = NULL; objPtr->internalRep.wideValue = longValue; objPtr->typePtr = &tclIntType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewLongObj( long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewWideIntObj(longValue); |
︙ | ︙ | |||
2932 2933 2934 2935 2936 2937 2938 | *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_SetLongObj void Tcl_SetLongObj( | | | | 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 | *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_SetLongObj void Tcl_SetLongObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ long longValue) /* Long integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); } TclSetIntObj(objPtr, longValue); |
︙ | ︙ | |||
2968 2969 2970 2971 2972 2973 2974 | * *---------------------------------------------------------------------- */ int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 | * *---------------------------------------------------------------------- */ int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a long. */ long *longPtr) /* Place to store resulting long. */ { do { #ifdef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclIntType) { *longPtr = objPtr->internalRep.wideValue; return TCL_OK; } |
︙ | ︙ | |||
3082 3083 3084 3085 3086 3087 3088 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewWideIntObj Tcl_Obj * Tcl_NewWideIntObj( | | | | | 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 3109 3110 3111 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewWideIntObj Tcl_Obj * Tcl_NewWideIntObj( Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { return Tcl_DbNewWideIntObj(wideValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewWideIntObj( Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); TclSetIntObj(objPtr, wideValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ |
︙ | ︙ | |||
3141 3142 3143 3144 3145 3146 3147 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewWideIntObj( | | | | | 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewWideIntObj( Tcl_WideInt wideValue, /* Wide integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); TclSetIntObj(objPtr, wideValue); return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewWideIntObj( Tcl_WideInt wideValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { |
︙ | ︙ | |||
3192 3193 3194 3195 3196 3197 3198 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetWideIntObj( | | | | 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetWideIntObj( Tcl_Obj *objPtr, /* Object w. internal rep to init. */ Tcl_WideInt wideValue) /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); } |
︙ | ︙ | |||
3228 3229 3230 3231 3232 3233 3234 | * *---------------------------------------------------------------------- */ int Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 | * *---------------------------------------------------------------------- */ int Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { if (objPtr->typePtr == &tclIntType) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } |
︙ | ︙ | |||
3921 3922 3923 3924 3925 3926 3927 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbIncrRefCount( | | | 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbIncrRefCount( Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG |
︙ | ︙ | |||
3984 3985 3986 3987 3988 3989 3990 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbDecrRefCount( | | | 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbDecrRefCount( Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG |
︙ | ︙ | |||
4050 4051 4052 4053 4054 4055 4056 | * None. * *---------------------------------------------------------------------- */ int Tcl_DbIsShared( | | | 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 | * None. * *---------------------------------------------------------------------- */ int Tcl_DbIsShared( Tcl_Obj *objPtr, /* The object to test for being shared. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG if (objPtr->refCount == 0x61616161) { |
︙ | ︙ | |||
4122 4123 4124 4125 4126 4127 4128 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitObjHashTable( | | | 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitObjHashTable( Tcl_HashTable *tablePtr) /* Pointer to table record, which is supplied * by the caller. */ { Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS, &tclObjHashKeyType); } |
︙ | ︙ | |||
4185 4186 4187 4188 4189 4190 4191 | int TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; | | | | 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 | int TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; const char *p1, *p2; size_t l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller if (objPtr1 == objPtr2) return 1; */ |
︙ | ︙ | |||
4343 4344 4345 4346 4347 4348 4349 | *---------------------------------------------------------------------- */ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ | | | | 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 | *---------------------------------------------------------------------- */ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ Tcl_Obj *objPtr) /* The object containing the command's name. * If the name starts with "::", will be * looked up in global namespace. Else, looked * up first in the current namespace, then in * global namespace. */ { ResolvedCmdName *resPtr; /* * Get the internal representation, converting to a command type if * needed. The internal representation is a ResolvedCmdName that points to * the actual command. * * Check the context namespace and the namespace epoch of the resolved |
︙ | ︙ | |||
4372 4373 4374 4375 4376 4377 4378 | * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (objPtr->typePtr == &tclCmdNameType) { | | | | 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 | * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (objPtr->typePtr == &tclCmdNameType) { Command *cmdPtr = resPtr->cmdPtr; if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) && (interp == cmdPtr->nsPtr->interp) && !(cmdPtr->nsPtr->flags & NS_DYING)) { Namespace *refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if ((resPtr->refNsPtr == NULL) || ((refNsPtr == resPtr->refNsPtr) && (resPtr->refNsId == refNsPtr->nsId) && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { return (Tcl_Command) cmdPtr; |
︙ | ︙ | |||
4479 4480 4481 4482 4483 4484 4485 | } } void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ | | | | 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 | } } void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { ResolvedCmdName *resPtr; if (objPtr->typePtr == &tclCmdNameType) { resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) { return; } } |
︙ | ︙ | |||
4519 4520 4521 4522 4523 4524 4525 | * ResolvedSymbol, which may free the Command structure. * *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( | | | | 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 | * ResolvedSymbol, which may free the Command structure. * *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * Decrement the reference count of the ResolvedCmdName structure. If * there are no more uses, free the ResolvedCmdName structure. */ if (resPtr->refCount-- <= 1) { |
︙ | ︙ | |||
4567 4568 4569 4570 4571 4572 4573 | * *---------------------------------------------------------------------- */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ | | | | 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 | * *---------------------------------------------------------------------- */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; resPtr->refCount++; copyPtr->typePtr = &tclCmdNameType; } |
︙ | ︙ | |||
4601 4602 4603 4604 4605 4606 4607 | * *---------------------------------------------------------------------- */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | | 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 | * *---------------------------------------------------------------------- */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { const char *name; Command *cmdPtr; ResolvedCmdName *resPtr; if (interp == NULL) { return TCL_ERROR; } /* * Find the Command structure, if any, that describes the command called |
︙ | ︙ |
Changes to generic/tclParse.c.
︙ | ︙ | |||
191 192 193 194 195 196 197 | int Tcl_ParseCommand( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ | | | | | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | int Tcl_ParseCommand( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ int nested, /* Non-zero means this is a nested command: * close bracket should be considered a * command terminator. If zero, then close * bracket has no special meaning. */ Tcl_Parse *parsePtr) /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { const char *src; /* Points to current character in the * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ int wordIndex; /* Index of word token for current word. */ int terminators; /* CHAR_TYPE bits that indicate the end of a * command. */ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to |
︙ | ︙ | |||
616 617 618 619 620 621 622 | * *---------------------------------------------------------------------- */ static int ParseWhiteSpace( const char *src, /* First character to parse. */ | | | | | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 | * *---------------------------------------------------------------------- */ static int ParseWhiteSpace( const char *src, /* First character to parse. */ int numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type * of character that ends run of whitespace */ { char type = TYPE_NORMAL; const char *p = src; while (1) { while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { numBytes--; p++; } if (numBytes && (type & TYPE_SUBS)) { |
︙ | ︙ | |||
725 726 727 728 729 730 731 | const char *src, /* First character to parse. */ int numBytes, /* Max number of byes to scan */ int *resultPtr) /* Points to storage provided by caller where * the character resulting from the * conversion is to be written. */ { int result = 0; | | | 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 | const char *src, /* First character to parse. */ int numBytes, /* Max number of byes to scan */ int *resultPtr) /* Points to storage provided by caller where * the character resulting from the * conversion is to be written. */ { int result = 0; const char *p = src; while (numBytes--) { unsigned char digit = UCHAR(*p); if (!isxdigit(digit) || (result > 0x10fff)) { break; } |
︙ | ︙ | |||
780 781 782 783 784 785 786 | const char *src, /* Points to the backslash character of a a * backslash sequence. */ int numBytes, /* Max number of bytes to scan. */ int *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be | | < | | 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 | const char *src, /* Points to the backslash character of a a * backslash sequence. */ int numBytes, /* Max number of bytes to scan. */ int *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be * written. At most 4 bytes will be written there. */ { const char *p = src+1; Tcl_UniChar unichar = 0; int result; int count; char buf[4] = ""; if (numBytes == 0) { if (readPtr != NULL) { |
︙ | ︙ | |||
963 964 965 966 967 968 969 | * *---------------------------------------------------------------------- */ static int ParseComment( const char *src, /* First character to parse. */ | | | | 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 | * *---------------------------------------------------------------------- */ static int ParseComment( const char *src, /* First character to parse. */ int numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ { const char *p = src; int incomplete = parsePtr->incomplete; while (numBytes) { int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); p += scanned; numBytes -= scanned; |
︙ | ︙ | |||
1035 1036 1037 1038 1039 1040 1041 | * None. * *---------------------------------------------------------------------- */ static int ParseTokens( | | | | 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 | * None. * *---------------------------------------------------------------------- */ static int ParseTokens( const char *src, /* First character to parse. */ int numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose * CHAR_TYPE contains any of the bits in * mask. */ int flags, /* OR-ed bits indicating what substitutions to * perform: TCL_SUBST_COMMANDS, * TCL_SUBST_VARIABLES, and |
︙ | ︙ | |||
1314 1315 1316 1317 1318 1319 1320 | int Tcl_ParseVarName( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ | | | | 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 | int Tcl_ParseVarName( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the variable name. */ int append) /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ { Tcl_Token *tokenPtr; const char *src; int varIndex; unsigned array; if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { |
︙ | ︙ | |||
1507 1508 1509 1510 1511 1512 1513 | * *---------------------------------------------------------------------- */ const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ | | | | 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 | * *---------------------------------------------------------------------- */ const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ const char *start, /* Start of variable substitution. First * character must be "$". */ const char **termPtr) /* If non-NULL, points to word to fill in with * character just after last one in the * variable specifier. */ { Tcl_Obj *objPtr; int code; Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) { TclStackFree(interp, parsePtr); return NULL; } |
︙ | ︙ | |||
1592 1593 1594 1595 1596 1597 1598 | int Tcl_ParseBraces( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ | | | | | 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 | int Tcl_ParseBraces( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ const char **termPtr) /* If non-NULL, points to word in which to * store a pointer to the character just after * the terminating '}' if the parse was * successful. */ { Tcl_Token *tokenPtr; const char *src; int startIndex, level, length; if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { numBytes = strlen(start); |
︙ | ︙ | |||
1734 1735 1736 1737 1738 1739 1740 | * Guess if the problem is due to comments by searching the source string * for a possible open brace within the context of a comment. Since we * aren't performing a full Tcl parse, just look for an open brace * preceded by a '<whitespace>#' on the same line. */ { | | | 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 | * Guess if the problem is due to comments by searching the source string * for a possible open brace within the context of a comment. Since we * aren't performing a full Tcl parse, just look for an open brace * preceded by a '<whitespace>#' on the same line. */ { int openBrace = 0; while (--src > start) { switch (*src) { case '{': openBrace = 1; break; case '\n': |
︙ | ︙ | |||
1794 1795 1796 1797 1798 1799 1800 | int Tcl_ParseQuotedString( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ | | | | 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 | int Tcl_ParseQuotedString( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ const char **termPtr) /* If non-NULL, points to word in which to |
︙ | ︙ |
Changes to generic/tclPathObj.c.
︙ | ︙ | |||
2238 2239 2240 2241 2242 2243 2244 | SetFsPathFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; | | | 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 | SetFsPathFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; const char *name; if (TclHasIntRep(pathPtr, &fsPathType)) { return TCL_OK; } /* * First step is to translate the filename. This is similar to |
︙ | ︙ | |||
2497 2498 2499 2500 2501 2502 2503 | * Memory may be allocated. * *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( | | | 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 | * Memory may be allocated. * *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); int cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { Tcl_Panic("Called UpdateStringOfFsPath with invalid object"); |
︙ | ︙ |
Changes to generic/tclPipe.c.
︙ | ︙ | |||
179 180 181 182 183 184 185 | void Tcl_DetachPids( int numPids, /* Number of pids to detach: gives size of * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { | | | 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 | void Tcl_DetachPids( int numPids, /* Number of pids to detach: gives size of * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { Detached *detPtr; int i; Tcl_MutexLock(&pipeMutex); for (i = 0; i < numPids; i++) { detPtr = ckalloc(sizeof(Detached)); detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; |
︙ | ︙ | |||
215 216 217 218 219 220 221 | * *---------------------------------------------------------------------- */ void Tcl_ReapDetachedProcs(void) { | | | 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | * *---------------------------------------------------------------------- */ void Tcl_ReapDetachedProcs(void) { Detached *detPtr; Detached *nextPtr, *prevPtr; int status, code; Tcl_MutexLock(&pipeMutex); for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { status = TclProcessWait(detPtr->pid, WNOHANG, &code, NULL, NULL); if (status == TCL_PROCESS_UNCHANGED || (status == TCL_PROCESS_ERROR |
︙ | ︙ | |||
409 410 411 412 413 414 415 | TclFile *inPipePtr, /* If non-NULL, input to the pipeline comes * from a pipe (unless overridden by * redirection in the command). The file id * with which to write to this pipe is stored * at *inPipePtr. NULL means command specified * its own input source. */ TclFile *outPipePtr, /* If non-NULL, output to the pipeline goes to | | | 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 | TclFile *inPipePtr, /* If non-NULL, input to the pipeline comes * from a pipe (unless overridden by * redirection in the command). The file id * with which to write to this pipe is stored * at *inPipePtr. NULL means command specified * its own input source. */ TclFile *outPipePtr, /* If non-NULL, output to the pipeline goes to * a pipe, unless overridden by redirection in * the command. The file id with which to read * frome this pipe is stored at *outPipePtr. * NULL means command specified its own output * sink. */ TclFile *errFilePtr) /* If non-NULL, all stderr output from the * pipeline will go to a temporary file * created here, and a descriptor to read the |
︙ | ︙ |
Changes to generic/tclPkg.c.
︙ | ︙ | |||
276 277 278 279 280 281 282 | { PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); if (pkgFiles && pkgFiles->names) { const char *name = pkgFiles->names->name; Tcl_HashTable *table = &pkgFiles->table; | | | | | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 | { PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); if (pkgFiles && pkgFiles->names) { const char *name = pkgFiles->names->name; Tcl_HashTable *table = &pkgFiles->table; int isNew; Tcl_HashEntry *entry = Tcl_CreateHashEntry(table, name, &isNew); Tcl_Obj *list; if (isNew) { list = Tcl_NewObj(); Tcl_SetHashValue(entry, list); Tcl_IncrRefCount(list); } else { list = Tcl_GetHashValue(entry); } Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fileName, -1)); |
︙ | ︙ |
Changes to generic/tclPlatDecls.h.
︙ | ︙ | |||
113 114 115 116 117 118 119 | #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT | > > > > > > > > > | | > | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\ && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8) #undef Tcl_WinUtfToTChar #undef Tcl_WinTCharToUtf #ifdef _WIN32 #define Tcl_WinUtfToTChar(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ (TCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr))) #define Tcl_WinTCharToUtf(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ (char *)Tcl_Char16ToUtfDString((string), ((((len) + 2) >> 1) - 1), (dsPtr))) #endif #endif #endif /* _TCLPLATDECLS */ |
Changes to generic/tclProc.c.
︙ | ︙ | |||
153 154 155 156 157 158 159 | int Tcl_ProcObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | int Tcl_ProcObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr; const char *procName; const char *simpleName, *procArgs, *procBody; Namespace *nsPtr, *altNsPtr, *cxtNsPtr; Tcl_Command cmd; if (objc != 4) { |
︙ | ︙ | |||
401 402 403 404 405 406 407 | const char *procName, /* Unqualified name of this proc. */ Tcl_Obj *argsPtr, /* Description of arguments. */ Tcl_Obj *bodyPtr, /* Command body. */ Proc **procPtrPtr) /* Returns: pointer to proc data. */ { Interp *iPtr = (Interp *) interp; | | | | 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 | const char *procName, /* Unqualified name of this proc. */ Tcl_Obj *argsPtr, /* Description of arguments. */ Tcl_Obj *bodyPtr, /* Command body. */ Proc **procPtrPtr) /* Returns: pointer to proc data. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr = NULL; int i, result, numArgs; CompiledLocal *localPtr = NULL; Tcl_Obj **argArray; int precompiled = 0; ProcGetIntRep(bodyPtr, procPtr); if (procPtr != NULL) { /* * Because the body is a TclProProcBody, the actual body is already |
︙ | ︙ | |||
757 758 759 760 761 762 763 | int TclObjGetFrame( Tcl_Interp *interp, /* Interpreter in which to find frame. */ Tcl_Obj *objPtr, /* Object describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { | | | 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 | int TclObjGetFrame( Tcl_Interp *interp, /* Interpreter in which to find frame. */ Tcl_Obj *objPtr, /* Object describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { Interp *iPtr = (Interp *) interp; int curLevel, level, result; const Tcl_ObjIntRep *irPtr; const char *name = NULL; Tcl_WideInt w; /* * Parse object to figure out which level number to go to. |
︙ | ︙ | |||
804 805 806 807 808 809 810 | ir.wideValue = level; Tcl_StoreIntRep(objPtr, &levelReferenceType, &ir); result = 1; } } else { result = -1; } | | > > | > > > > > | | < | | | 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 | ir.wideValue = level; Tcl_StoreIntRep(objPtr, &levelReferenceType, &ir); result = 1; } } else { result = -1; } } else if (TclGetWideBitsFromObj(NULL, objPtr, &w) == TCL_OK) { /* * If this were an integer, we'd have succeeded already. * Docs say we have to treat this as a 'bad level' error. */ result = -1; } } if (result != -1) { /* if relative current level */ if (result == 0) { if (!curLevel) { /* we are in top-level, so simply generate bad level */ name = "1"; goto badLevel; } level = curLevel - 1; } if (level >= 0) { CallFrame *framePtr; for (framePtr = iPtr->varFramePtr; framePtr != NULL; framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { *framePtrPtr = framePtr; return result; } } } } badLevel: if (name == NULL) { name = objPtr ? TclGetString(objPtr) : "1" ; } Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL); return -1; } /* |
︙ | ︙ | |||
894 895 896 897 898 899 900 | TclNRUplevelObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 | TclNRUplevelObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; int result; CallFrame *savedVarFramePtr, *framePtr; Tcl_Obj *objPtr; if (objc < 2) { |
︙ | ︙ | |||
1034 1035 1036 1037 1038 1039 1040 | static int ProcWrongNumArgs( Tcl_Interp *interp, int skip) { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; | | | 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 | static int ProcWrongNumArgs( Tcl_Interp *interp, int skip) { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; Proc *procPtr = framePtr->procPtr; int localCt = procPtr->numCompiledLocals, numArgs, i; Tcl_Obj **desiredObjs; const char *final = NULL; /* * Build up desired argument list for Tcl_WrongNumArgs */ |
︙ | ︙ | |||
1059 1060 1061 1062 1063 1064 1065 | #else desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); #endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { | | | 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 | #else desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); #endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); for (i=1 ; i<=numArgs ; i++, defPtr++) { Tcl_Obj *argObj; Tcl_Obj *namePtr = localName(framePtr, i-1); if (defPtr->value.objPtr != NULL) { TclNewObj(argObj); |
︙ | ︙ | |||
1250 1251 1252 1253 1254 1255 1256 | /* * Now invoke the resolvers to determine the exact variables that * should be used. */ resVarInfo = localPtr->resolveInfo; if (resVarInfo && resVarInfo->fetchProc) { | | | 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 | /* * Now invoke the resolvers to determine the exact variables that * should be used. */ resVarInfo = localPtr->resolveInfo; if (resVarInfo && resVarInfo->fetchProc) { Var *resolvedVarPtr = (Var *) resVarInfo->fetchProc(interp, resVarInfo); if (resolvedVarPtr) { if (TclIsVarInHash(resolvedVarPtr)) { VarHashRefCount(resolvedVarPtr)++; } varPtr->flags = VAR_LINK; |
︙ | ︙ | |||
1273 1274 1275 1276 1277 1278 1279 | Tcl_Interp *interp, LocalCache *localCachePtr) { int i; Tcl_Obj **namePtrPtr = &localCachePtr->varName0; for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) { | | | 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 | Tcl_Interp *interp, LocalCache *localCachePtr) { int i; Tcl_Obj **namePtrPtr = &localCachePtr->varName0; for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) { Tcl_Obj *objPtr = *namePtrPtr; if (objPtr) { /* TclReleaseLiteral calls Tcl_DecrRefCount for us */ TclReleaseLiteral(interp, objPtr); } } ckfree(localCachePtr); |
︙ | ︙ | |||
1296 1297 1298 1299 1300 1301 1302 | int localCt = procPtr->numCompiledLocals; int numArgs = procPtr->numArgs, i = 0; Tcl_Obj **namePtr; Var *varPtr; LocalCache *localCachePtr; CompiledLocal *localPtr; | | | 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 | int localCt = procPtr->numCompiledLocals; int numArgs = procPtr->numArgs, i = 0; Tcl_Obj **namePtr; Var *varPtr; LocalCache *localCachePtr; CompiledLocal *localPtr; int isNew; ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); /* * Cache the names and initial values of local variables; store the * cache in both the framePtr for this execution and in the codePtr * for future calls. |
︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 | localPtr = procPtr->firstLocalPtr; while (localPtr) { if (TclIsVarTemporary(localPtr)) { *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, localPtr->nameLength, /* hash */ (unsigned int) -1, | | | 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 | localPtr = procPtr->firstLocalPtr; while (localPtr) { if (TclIsVarTemporary(localPtr)) { *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, localPtr->nameLength, /* hash */ (unsigned int) -1, &isNew, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } if (i < numArgs) { varPtr->flags = (localPtr->flags & VAR_IS_ARGS); varPtr->value.objPtr = localPtr->defValuePtr; varPtr++; |
︙ | ︙ | |||
1359 1360 1361 1362 1363 1364 1365 | * are being referenced at runtime. * *---------------------------------------------------------------------- */ static int InitArgsAndLocals( | | | | | 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 | * are being referenced at runtime. * *---------------------------------------------------------------------- */ static int InitArgsAndLocals( Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; Proc *procPtr = framePtr->procPtr; ByteCode *codePtr; Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); /* * Make sure that the local cache of variable names and initial values has |
︙ | ︙ | |||
1526 1527 1528 1529 1530 1531 1532 | *---------------------------------------------------------------------- */ int TclPushProcCallFrame( ClientData clientData, /* Record describing procedure to be * interpreted. */ | | | 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 | *---------------------------------------------------------------------- */ int TclPushProcCallFrame( ClientData clientData, /* Record describing procedure to be * interpreted. */ Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[], /* Argument value objects. */ int isLambda) /* 1 if this is a call by ApplyObjCmd: it * needs special rules for error msg */ { |
︙ | ︙ | |||
1618 1619 1620 1621 1622 1623 1624 | *---------------------------------------------------------------------- */ int TclObjInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ | | | | 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 | *---------------------------------------------------------------------- */ int TclObjInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { /* * Not used much in the core; external interface for iTcl */ return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv); } int TclNRInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { int result = TclPushProcCallFrame(clientData, interp, objc, objv, /*isLambda*/ 0); |
︙ | ︙ | |||
1670 1671 1672 1673 1674 1675 1676 | * Nearly anything; depends on the commands in the procedure body. * *---------------------------------------------------------------------- */ int TclNRInterpProcCore( | | | | | | 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 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 | * Nearly anything; depends on the commands in the procedure body. * *---------------------------------------------------------------------- */ int TclNRInterpProcCore( Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ int skip, /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ ProcErrorProc *errorProc) /* How to convert results from the script into * results of the overall procedure. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr = iPtr->varFramePtr->procPtr; int result; CallFrame *freePtr; ByteCode *codePtr; result = InitArgsAndLocals(interp, procNameObj, skip); if (result != TCL_OK) { freePtr = iPtr->framePtr; Tcl_PopCallFrame(interp); /* Pop but do not free. */ TclStackFree(interp, freePtr->compiledLocals); /* Free compiledLocals. */ TclStackFree(interp, freePtr); /* Free CallFrame. */ return TCL_ERROR; } #if defined(TCL_COMPILE_DEBUG) if (tclTraceExec >= 1) { CallFrame *framePtr = iPtr->varFramePtr; int i; if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { fprintf(stdout, "Calling lambda "); } else { fprintf(stdout, "Calling proc "); } for (i = 0; i < framePtr->objc; i++) { |
︙ | ︙ | |||
1843 1844 1845 1846 1847 1848 1849 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invoked \"%s\" outside of a loop", ((result == TCL_BREAK) ? "break" : "continue"))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL); result = TCL_ERROR; | | < < | 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invoked \"%s\" outside of a loop", ((result == TCL_BREAK) ? "break" : "continue"))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL); result = TCL_ERROR; /* FALLTHRU */ case TCL_ERROR: /* * Now it _must_ be an error, so we need to log it as such. This means * filling out the error trace. Luckily, we just hand this off to the * function handed to us as an argument. */ |
︙ | ︙ | |||
2115 2116 2117 2118 2119 2120 2121 | * Memory gets freed. * *---------------------------------------------------------------------- */ void TclProcCleanupProc( | | | | 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 | * Memory gets freed. * *---------------------------------------------------------------------- */ void TclProcCleanupProc( Proc *procPtr) /* Procedure to be deleted. */ { CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; Tcl_HashEntry *hePtr = NULL; CmdFrame *cfPtr = NULL; Interp *iPtr = procPtr->iPtr; |
︙ | ︙ | |||
2366 2367 2368 2369 2370 2371 2372 | * *---------------------------------------------------------------------- */ static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ | | | | | 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 | * *---------------------------------------------------------------------- */ static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; LambdaGetIntRep(srcPtr, procPtr, nsObjPtr); assert(procPtr != NULL); procPtr->refCount++; LambdaSetIntRep(copyPtr, procPtr, nsObjPtr); } static void FreeLambdaInternalRep( Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; LambdaGetIntRep(objPtr, procPtr, nsObjPtr); assert(procPtr != NULL); if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); } TclDecrRefCount(nsObjPtr); } static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; int isNew, objc, result; CmdFrame *cfPtr = NULL; Proc *procPtr; |
︙ | ︙ |
Changes to generic/tclRegexp.c.
︙ | ︙ | |||
721 722 723 724 725 726 727 | { char buf[100]; /* ample in practice */ char cbuf[TCL_INTEGER_SPACE]; size_t n; const char *p; Tcl_ResetResult(interp); | | | | 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 | { char buf[100]; /* ample in practice */ char cbuf[TCL_INTEGER_SPACE]; size_t n; const char *p; Tcl_ResetResult(interp); n = TclReError(status, buf, sizeof(buf)); p = (n > sizeof(buf)) ? "..." : ""; Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p)); sprintf(cbuf, "%d", status); (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf)); Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL); } /* *---------------------------------------------------------------------- * * FreeRegexpInternalRep -- |
︙ | ︙ |
Changes to generic/tclResult.c.
︙ | ︙ | |||
410 411 412 413 414 415 416 | *---------------------------------------------------------------------- */ void Tcl_SetResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return value. */ | | | | 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 | *---------------------------------------------------------------------- */ void Tcl_SetResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return value. */ char *result, /* Value to be returned. If NULL, the result * is set to an empty string. */ Tcl_FreeProc *freeProc) /* Gives information about the string: * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { Interp *iPtr = (Interp *) interp; Tcl_FreeProc *oldFreeProc = iPtr->freeProc; char *oldResult = iPtr->result; if (result == NULL) { iPtr->resultSpace[0] = 0; iPtr->result = iPtr->resultSpace; iPtr->freeProc = 0; } else if (freeProc == TCL_VOLATILE) { |
︙ | ︙ | |||
480 481 482 483 484 485 486 | * string result, then the object result is reset. * *---------------------------------------------------------------------- */ const char * Tcl_GetStringResult( | | | 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 | * string result, then the object result is reset. * *---------------------------------------------------------------------- */ const char * Tcl_GetStringResult( Tcl_Interp *interp)/* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; /* * If the string result is empty, move the object result to the string * result, then reset the object result. */ |
︙ | ︙ | |||
519 520 521 522 523 524 525 | *---------------------------------------------------------------------- */ void Tcl_SetObjResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return object value. */ | | | | | 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | *---------------------------------------------------------------------- */ void Tcl_SetObjResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return object value. */ Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj * result is made an empty string object. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldObjResult = iPtr->objResultPtr; iPtr->objResultPtr = objPtr; Tcl_IncrRefCount(objPtr); /* since interp result is a reference */ /* * We wait until the end to release the old object result, in case we are * setting the result to itself. |
︙ | ︙ | |||
578 579 580 581 582 583 584 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { | | | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; #ifndef TCL_NO_DEPRECATED Tcl_Obj *objResultPtr; int length; /* * If the string result is non-empty, move the string result to the object * result, then reset the string result. |
︙ | ︙ | |||
828 829 830 831 832 833 834 | */ iPtr->appendUsed = strlen(iPtr->result); } totalSpace = newSpace + iPtr->appendUsed; if (totalSpace >= iPtr->appendAvl) { | | | | | | 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 | */ iPtr->appendUsed = strlen(iPtr->result); } totalSpace = newSpace + iPtr->appendUsed; if (totalSpace >= iPtr->appendAvl) { char *newSpace; if (totalSpace < 100) { totalSpace = 200; } else { totalSpace *= 2; } newSpace = ckalloc(totalSpace); strcpy(newSpace, iPtr->result); if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); } iPtr->appendResult = newSpace; iPtr->appendAvl = totalSpace; } else if (iPtr->result != iPtr->appendResult) { strcpy(iPtr->appendResult, iPtr->result); } Tcl_FreeResult((Tcl_Interp *) iPtr); iPtr->result = iPtr->appendResult; |
︙ | ︙ | |||
875 876 877 878 879 880 881 | * object. * *---------------------------------------------------------------------- */ void Tcl_FreeResult( | | | | 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 | * object. * *---------------------------------------------------------------------- */ void Tcl_FreeResult( Tcl_Interp *interp)/* Interpreter for which to free result. */ { Interp *iPtr = (Interp *) interp; #ifndef TCL_NO_DEPRECATED if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); |
︙ | ︙ | |||
914 915 916 917 918 919 920 | * It also clears any error information for the interpreter. * *---------------------------------------------------------------------- */ void Tcl_ResetResult( | | | | 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 | * It also clears any error information for the interpreter. * *---------------------------------------------------------------------- */ void Tcl_ResetResult( Tcl_Interp *interp)/* Interpreter for which to clear result. */ { Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); #ifndef TCL_NO_DEPRECATED if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { |
︙ | ︙ | |||
979 980 981 982 983 984 985 | * the interpreter. * *---------------------------------------------------------------------- */ static void ResetObjResult( | | | | 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 | * the interpreter. * *---------------------------------------------------------------------- */ static void ResetObjResult( Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { Tcl_Obj *objResultPtr = iPtr->objResultPtr; if (Tcl_IsShared(objResultPtr)) { TclDecrRefCount(objResultPtr); TclNewObj(objResultPtr); Tcl_IncrRefCount(objResultPtr); iPtr->objResultPtr = objResultPtr; } else { |
︙ | ︙ |
Changes to generic/tclScan.c.
︙ | ︙ | |||
359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 | case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } case 'L': flags |= SCAN_LONGER; case 'h': format += TclUtfToUniChar(format, &ch); } if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) { goto badIndex; } | > > | 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 | case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } /* FALLTHRU */ case 'L': flags |= SCAN_LONGER; /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) { goto badIndex; } |
︙ | ︙ | |||
382 383 384 385 386 387 388 | if (flags & SCAN_WIDTH) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "field width may not be specified in %c conversion", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL); goto error; } | | < < | 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | if (flags & SCAN_WIDTH) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "field width may not be specified in %c conversion", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL); goto error; } /* FALLTHRU */ case 'n': case 's': if (flags & (SCAN_LONGER|SCAN_BIG)) { invalidFieldSize: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; errorMsg = Tcl_NewStringObj( "field size modifier may not be specified in %", -1); |
︙ | ︙ | |||
699 700 701 702 703 704 705 706 707 | case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } case 'L': flags |= SCAN_LONGER; | > | < < | 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 | case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } /* FALLTHRU */ case 'L': flags |= SCAN_LONGER; /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } /* * Handle the various field types. */ |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 | segment = Tcl_NewStringObj(buf, length); Tcl_IncrRefCount(segment); allocSegment = 1; break; } case 'u': case 'd': case 'o': case 'p': case 'x': case 'X': case 'b': { short s = 0; /* Silence compiler warning; only defined and | > | 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 | segment = Tcl_NewStringObj(buf, length); Tcl_IncrRefCount(segment); allocSegment = 1; break; } case 'u': /* FALLTHRU */ case 'd': case 'o': case 'p': case 'x': case 'X': case 'b': { short s = 0; /* Silence compiler warning; only defined and |
︙ | ︙ | |||
2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 | break; case 'L': size = 3; p++; break; case 'h': size = -1; default: p++; } } while (seekingConversion); } TclListObjGetElements(NULL, list, &objc, &objv); code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); | > | 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 | break; case 'L': size = 3; p++; break; case 'h': size = -1; /* FALLTHRU */ default: p++; } } while (seekingConversion); } TclListObjGetElements(NULL, list, &objc, &objv); code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); |
︙ | ︙ | |||
3559 3560 3561 3562 3563 3564 3565 | /* We don't find empty substrings. Bizarre! * Whenever this routine is turned into a proper substring * finder, change to `return start` after limits imposed. */ return -1; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { | | | | | | | | | | | | | | | | 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 | /* We don't find empty substrings. Bizarre! * Whenever this routine is turned into a proper substring * finder, change to `return start` after limits imposed. */ return -1; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { unsigned char *end, *check, *bh; unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); /* Find bytes in bytes */ bh = Tcl_GetByteArrayFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ return -1; } end = bh + lh; check = bh + start; while (check + ln <= end) { /* * Look for the leading byte of the needle in the haystack * starting at check and stopping when there's not enough room * for the needle left. */ check = memchr(check, bn[0], (end + 1 - ln) - check); if (check == NULL) { /* Leading byte not found -> needle cannot be found. */ return -1; } /* Leading byte found, check rest of needle. */ if (0 == memcmp(check+1, bn+1, ln-1)) { /* Checks! Return the successful index. */ return (check - bh); } /* Rest of needle match failed; Iterate to continue search. */ check++; } return -1; } /* * TODO: It might be nice to support some cases where it is not * necessary to shimmer to &tclStringType to compute the result, * and instead operate just on the objPtr->bytes values directly. * However, we also do not want the answer to change based on the * code pathway, or if it does we want that to be for some values * we explicitly decline to support. Getting there will involve * locking down in practice more firmly just what encodings produce * what supported results for the objPtr->bytes values. For now, * do only the well-defined Tcl_UniChar array search. */ { Tcl_UniChar *check, *end, *uh; Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); uh = Tcl_GetUnicodeFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ return -1; } end = uh + lh; for (check = uh + start; check + ln <= end; check++) { if ((*check == *un) && (0 == memcmp(check + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) { return (check - uh); } } return -1; } } /* |
︙ | ︙ | |||
3663 3664 3665 3666 3667 3668 3669 | * TODO: When we one day make this a true substring * finder, change this to "return last", after limitation. */ return -1; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { | | | | | | | | | | | | | | | | 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 | * TODO: When we one day make this a true substring * finder, change this to "return last", after limitation. */ return -1; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); if (last >= lh) { last = lh - 1; } if (last + 1 < ln) { /* Don't start the loop if there cannot be a valid answer */ return -1; } check = bh + last + 1 - ln; while (check >= bh) { if ((*check == bn[0]) && (0 == memcmp(check+1, bn+1, ln-1))) { return (check - bh); } check--; } return -1; } { Tcl_UniChar *check, *uh = Tcl_GetUnicodeFromObj(haystack, &lh); Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); if (last >= lh) { last = lh - 1; } if (last + 1 < ln) { /* Don't start the loop if there cannot be a valid answer */ return -1; } check = uh + last + 1 - ln; while (check >= uh) { if ((*check == un[0]) && (0 == memcmp(check+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) { return (check - uh); } check--; } return -1; } } /* *--------------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
56 57 58 59 60 61 62 63 64 65 66 67 68 69 | #undef TclWinGetSockOpt #undef TclWinSetSockOpt #undef TclWinNToHS #undef TclStaticPackage #undef TclBNInitBignumFromLong #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage #undef TclBN_mp_tc_and #undef TclBN_mp_tc_or #undef TclBN_mp_tc_xor #define TclBN_mp_tc_and TclBN_mp_and #define TclBN_mp_tc_or TclBN_mp_or #define TclBN_mp_tc_xor TclBN_mp_xor | > > > | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | #undef TclWinGetSockOpt #undef TclWinSetSockOpt #undef TclWinNToHS #undef TclStaticPackage #undef TclBNInitBignumFromLong #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar #undef TclBN_mp_tc_and #undef TclBN_mp_tc_or #undef TclBN_mp_tc_xor #define TclBN_mp_tc_and TclBN_mp_and #define TclBN_mp_tc_or TclBN_mp_or #define TclBN_mp_tc_xor TclBN_mp_xor |
︙ | ︙ | |||
241 242 243 244 245 246 247 248 249 250 251 252 253 254 | int TclpGetPid(Tcl_Pid pid) { return (int) (size_t) pid; } char * Tcl_WinUtfToTChar( const char *string, int len, Tcl_DString *dsPtr) { Tcl_DStringInit(dsPtr); | > > < < < | | < | | | < < < < < < | 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 | int TclpGetPid(Tcl_Pid pid) { return (int) (size_t) pid; } #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #undef Tcl_WinUtfToTChar char * Tcl_WinUtfToTChar( const char *string, int len, Tcl_DString *dsPtr) { Tcl_DStringInit(dsPtr); return (char *)Tcl_UtfToChar16DString(string, len, dsPtr); } #undef Tcl_WinTCharToUtf char * Tcl_WinTCharToUtf( const char *string, int len, Tcl_DString *dsPtr) { Tcl_DStringInit(dsPtr); return Tcl_Char16ToUtfDString((const unsigned short *)string, len >> 1, dsPtr); } #endif /* !defined(TCL_NO_DEPRECATED) */ #if defined(TCL_WIDE_INT_IS_LONG) /* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore * we have to make sure that all stub entries on Cygwin64 follow the Win64 * signature. Tcl 9 must find a better solution, but that cannot be done * without introducing a binary incompatibility. */ |
︙ | ︙ | |||
474 475 476 477 478 479 480 481 482 483 484 485 486 487 | static int tellOld( Tcl_Channel chan) /* The channel to return pos for. */ { return Tcl_Tell(chan); } #endif /* !TCL_NO_DEPRECATED */ /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations * below should be made in the generic/tcl.decls script. */ | > > > > > | 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 | static int tellOld( Tcl_Channel chan) /* The channel to return pos for. */ { return Tcl_Tell(chan); } #endif /* !TCL_NO_DEPRECATED */ #if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 #define Tcl_WinUtfToTChar 0 #define Tcl_WinTCharToUtf 0 #endif /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations * below should be made in the generic/tcl.decls script. */ |
︙ | ︙ | |||
1328 1329 1330 1331 1332 1333 1334 | Tcl_UtfFindLast, /* 329 */ Tcl_UtfNext, /* 330 */ Tcl_UtfPrev, /* 331 */ Tcl_UtfToExternal, /* 332 */ Tcl_UtfToExternalDString, /* 333 */ Tcl_UtfToLower, /* 334 */ Tcl_UtfToTitle, /* 335 */ | | | | | 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 | Tcl_UtfFindLast, /* 329 */ Tcl_UtfNext, /* 330 */ Tcl_UtfPrev, /* 331 */ Tcl_UtfToExternal, /* 332 */ Tcl_UtfToExternalDString, /* 333 */ Tcl_UtfToLower, /* 334 */ Tcl_UtfToTitle, /* 335 */ Tcl_UtfToChar16, /* 336 */ Tcl_UtfToUpper, /* 337 */ Tcl_WriteChars, /* 338 */ Tcl_WriteObj, /* 339 */ Tcl_GetString, /* 340 */ Tcl_GetDefaultEncodingDir, /* 341 */ Tcl_SetDefaultEncodingDir, /* 342 */ Tcl_AlertNotifier, /* 343 */ Tcl_ServiceModeHook, /* 344 */ Tcl_UniCharIsAlnum, /* 345 */ Tcl_UniCharIsAlpha, /* 346 */ Tcl_UniCharIsDigit, /* 347 */ Tcl_UniCharIsLower, /* 348 */ Tcl_UniCharIsSpace, /* 349 */ Tcl_UniCharIsUpper, /* 350 */ Tcl_UniCharIsWordChar, /* 351 */ Tcl_UniCharLen, /* 352 */ Tcl_UniCharNcmp, /* 353 */ Tcl_Char16ToUtfDString, /* 354 */ Tcl_UtfToChar16DString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ Tcl_EvalTokens, /* 357 */ Tcl_FreeParse, /* 358 */ Tcl_LogCommandInfo, /* 359 */ Tcl_ParseBraces, /* 360 */ Tcl_ParseCommand, /* 361 */ Tcl_ParseExpr, /* 362 */ |
︙ | ︙ | |||
1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 | Tcl_StoreIntRep, /* 639 */ Tcl_HasStringRep, /* 640 */ Tcl_IncrRefCount, /* 641 */ Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ Tcl_GetIntForIndex, /* 645 */ }; /* !END!: Do not edit above this line. */ | > > > | 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 | Tcl_StoreIntRep, /* 639 */ Tcl_HasStringRep, /* 640 */ Tcl_IncrRefCount, /* 641 */ Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ Tcl_GetIntForIndex, /* 645 */ Tcl_UtfToUniChar, /* 646 */ Tcl_UniCharToUtfDString, /* 647 */ Tcl_UtfToUniCharDString, /* 648 */ }; /* !END!: Do not edit above this line. */ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
24 25 26 27 28 29 30 | #include <math.h> /* * Required for Testregexp*Cmd */ #include "tclRegexp.h" | < < < < < | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | #include <math.h> /* * Required for Testregexp*Cmd */ #include "tclRegexp.h" /* * Required for the TestChannelCmd and TestChannelEventCmd */ #include "tclIO.h" /* * Declare external functions used in Windows tests. |
︙ | ︙ | |||
221 222 223 224 225 226 227 228 229 230 231 232 233 234 | Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static void SpecialFree(char *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static int TestasyncCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestbytestringObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestpurebytesobjObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TeststringbytesObjCmd(void *clientData, | > > > | 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 | Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static void SpecialFree(char *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static int TestasyncCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestbumpinterpepochObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestbytestringObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestpurebytesobjObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TeststringbytesObjCmd(void *clientData, |
︙ | ︙ | |||
597 598 599 600 601 602 603 604 605 606 607 608 609 610 | Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", TestGetIndexFromObjStructObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL, | > > | 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 | Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", TestGetIndexFromObjStructObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbumpinterpepoch", TestbumpinterpepochObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL, |
︙ | ︙ | |||
1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 | } } Tcl_MutexUnlock(&asyncTestMutex); Tcl_ExitThread(TCL_OK); TCL_THREAD_CREATE_RETURN; } #endif /* *---------------------------------------------------------------------- * * TestcmdinfoCmd -- * * This procedure implements the "testcmdinfo" command. It is used to | > > > > > > > > > > > > > > > > | 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 | } } Tcl_MutexUnlock(&asyncTestMutex); Tcl_ExitThread(TCL_OK); TCL_THREAD_CREATE_RETURN; } #endif static int TestbumpinterpepochObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *)interp; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } iPtr->compileEpoch++; return TCL_OK; } /* *---------------------------------------------------------------------- * * TestcmdinfoCmd -- * * This procedure implements the "testcmdinfo" command. It is used to |
︙ | ︙ | |||
2400 2401 2402 2403 2404 2405 2406 | } static void ExitProcOdd( void *clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; | | | | | | | | 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 | } static void ExitProcOdd( void *clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; int len; sprintf(buf, "odd %d\n", (int)PTR2INT(clientData)); len = strlen(buf); if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcOdd: unable to write to stdout"); } } static void ExitProcEven( void *clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; int len; sprintf(buf, "even %d\n", (int)PTR2INT(clientData)); len = strlen(buf); if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcEven: unable to write to stdout"); } } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
5172 5173 5174 5175 5176 5177 5178 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsetCmd( void *data, /* Additional flags for Get/SetVar2. */ | | | 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsetCmd( void *data, /* Additional flags for Get/SetVar2. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); const char *value; if (argc == 2) { |
︙ | ︙ | |||
5204 5205 5206 5207 5208 5209 5210 | argv[0], " varName ?newValue?\"", NULL); return TCL_ERROR; } } static int Testset2Cmd( void *data, /* Additional flags for Get/SetVar2. */ | | | 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 | argv[0], " varName ?newValue?\"", NULL); return TCL_ERROR; } } static int Testset2Cmd( void *data, /* Additional flags for Get/SetVar2. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); const char *value; if (argc == 3) { |
︙ | ︙ | |||
5255 5256 5257 5258 5259 5260 5261 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsaveresultCmd( void *dummy, /* Not used. */ | | | 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsaveresultCmd( void *dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; |
︙ | ︙ | |||
5386 5387 5388 5389 5390 5391 5392 | * *---------------------------------------------------------------------- */ static int TestmainthreadCmd( void *dummy, /* Not used. */ | | | 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 | * *---------------------------------------------------------------------- */ static int TestmainthreadCmd( void *dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc == 1) { Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); Tcl_SetObjResult(interp, idObj); |
︙ | ︙ | |||
5447 5448 5449 5450 5451 5452 5453 | * *---------------------------------------------------------------------- */ static int TestsetmainloopCmd( void *dummy, /* Not used. */ | | | 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 | * *---------------------------------------------------------------------- */ static int TestsetmainloopCmd( void *dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { exitMainLoop = 0; Tcl_SetMainLoop(MainLoop); return TCL_OK; } |
︙ | ︙ | |||
5476 5477 5478 5479 5480 5481 5482 | * *---------------------------------------------------------------------- */ static int TestexitmainloopCmd( void *dummy, /* Not used. */ | | | 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 | * *---------------------------------------------------------------------- */ static int TestexitmainloopCmd( void *dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { exitMainLoop = 1; return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
49 50 51 52 53 54 55 | int objc, Tcl_Obj *const objv[]); #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp) { | | | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | int objc, Tcl_Obj *const objv[]); #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp) { int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); } Tcl_DeleteAssocData(interp, VARPTR_KEY); ckfree(varPtr); } |
︙ | ︙ | |||
87 88 89 90 91 92 93 | *---------------------------------------------------------------------- */ int TclObjTest_Init( Tcl_Interp *interp) { | | | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | *---------------------------------------------------------------------- */ int TclObjTest_Init( Tcl_Interp *interp) { int i; /* * An array of Tcl_Obj pointers used in the commands that operate on or get * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's * Tcl_Obj *. */ Tcl_Obj **varPtr; |
︙ | ︙ | |||
1174 1175 1176 1177 1178 1179 1180 | int varIndex, option, i, length; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; String *strPtr; Tcl_Obj **varPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", | | | | 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 | int varIndex, option, i, length; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; String *strPtr; Tcl_Obj **varPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", "set", "set2", "setlength", "maxchars", "appendself", "appendself2", NULL }; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
1340 1341 1342 1343 1344 1345 1346 | strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; | | < < < < < < | 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 | strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; case 10: /* appendself */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } |
︙ | ︙ | |||
1377 1378 1379 1380 1381 1382 1383 | "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; | | | 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 | "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 11: /* appendself2 */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } |
︙ | ︙ |
Changes to generic/tclTestProcBodyObj.c.
︙ | ︙ | |||
47 48 49 50 51 52 53 | static int ProcBodyTestProcObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestCheckObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); static int RegisterCommand(Tcl_Interp* interp, | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | static int ProcBodyTestProcObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestCheckObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); static int RegisterCommand(Tcl_Interp* interp, const char *namesp, const CmdTable *cmdTablePtr); /* * List of commands to create when the package is loaded; must go after the * declarations of the enable command procedure. */ static const CmdTable commands[] = { |
︙ | ︙ | |||
135 136 137 138 139 140 141 | *---------------------------------------------------------------------- */ static int RegisterCommand( Tcl_Interp* interp, /* the Tcl interpreter for which the operation * is performed */ | | | | | 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | *---------------------------------------------------------------------- */ static int RegisterCommand( Tcl_Interp* interp, /* the Tcl interpreter for which the operation * is performed */ const char *namesp, /* the namespace in which the command is * registered */ const CmdTable *cmdTablePtr)/* the command to register */ { char buf[128]; if (cmdTablePtr->exportIt) { sprintf(buf, "namespace eval %s { namespace export %s }", namesp, cmdTablePtr->cmdName); if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) { return TCL_ERROR; } } sprintf(buf, "%s::%s", namesp, cmdTablePtr->cmdName); Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclThreadAlloc.c.
︙ | ︙ | |||
244 245 246 247 248 249 250 | void TclFreeAllocCache( void *arg) { Cache *cachePtr = arg; Cache **nextPtrPtr; | | | 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 | void TclFreeAllocCache( void *arg) { Cache *cachePtr = arg; Cache **nextPtrPtr; unsigned int bucket; /* * Flush blocks. */ for (bucket = 0; bucket < NBUCKETS; ++bucket) { if (cachePtr->buckets[bucket].numFree > 0) { |
︙ | ︙ | |||
301 302 303 304 305 306 307 | char * TclpAlloc( unsigned int reqSize) { Cache *cachePtr; Block *blockPtr; | | | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | char * TclpAlloc( unsigned int reqSize) { Cache *cachePtr; Block *blockPtr; int bucket; size_t size; #ifndef __LP64__ if (sizeof(int) >= sizeof(size_t)) { /* An unsigned int overflow can also be a size_t overflow */ const size_t zero = 0; const size_t max = ~zero; |
︙ | ︙ | |||
533 534 535 536 537 538 539 | * *---------------------------------------------------------------------- */ Tcl_Obj * TclThreadAllocObj(void) { | | | | | 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 | * *---------------------------------------------------------------------- */ Tcl_Obj * TclThreadAllocObj(void) { Cache *cachePtr; Tcl_Obj *objPtr; GETCACHE(cachePtr); /* * Get this thread's obj list structure and move or allocate new objs if * necessary. */ if (cachePtr->numObjects == 0) { int numMove; Tcl_MutexLock(objLockPtr); numMove = sharedPtr->numObjects; if (numMove > 0) { if (numMove > NOBJALLOC) { numMove = NOBJALLOC; } |
︙ | ︙ | |||
705 706 707 708 709 710 711 | static void MoveObjs( Cache *fromPtr, Cache *toPtr, int numMove) { | | | 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 | static void MoveObjs( Cache *fromPtr, Cache *toPtr, int numMove) { Tcl_Obj *objPtr = fromPtr->firstObjPtr; Tcl_Obj *fromFirstObjPtr = objPtr; toPtr->numObjects += numMove; fromPtr->numObjects -= numMove; /* * Find the last object to be moved; set the next one (the first one not |
︙ | ︙ | |||
806 807 808 809 810 811 812 | static char * Block2Ptr( Block *blockPtr, int bucket, unsigned int reqSize) { | | | | 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 | static char * Block2Ptr( Block *blockPtr, int bucket, unsigned int reqSize) { void *ptr; blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC; blockPtr->sourceBucket = bucket; blockPtr->blockReqSize = reqSize; ptr = ((void *) (blockPtr + 1)); #if RCHECK ((unsigned char *)(ptr))[reqSize] = MAGIC; #endif return (char *) ptr; } static Block * Ptr2Block( char *ptr) { Block *blockPtr; blockPtr = (((Block *) ptr) - 1); if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) { Tcl_Panic("alloc: invalid block: %p: %x %x", blockPtr, blockPtr->magicNum1, blockPtr->magicNum2); } #if RCHECK |
︙ | ︙ | |||
956 957 958 959 960 961 962 | */ static int GetBlocks( Cache *cachePtr, int bucket) { | | | | 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 | */ static int GetBlocks( Cache *cachePtr, int bucket) { Block *blockPtr; int n; /* * First, atttempt to move blocks from the shared cache. Note the * potentially dirty read of numFree before acquiring the lock which is a * slight performance enhancement. The value is verified after the lock is * actually acquired. */ |
︙ | ︙ | |||
1002 1003 1004 1005 1006 1007 1008 | blockPtr->nextBlock = NULL; } } UnlockBucket(cachePtr, bucket); } if (cachePtr->buckets[bucket].numFree == 0) { | | | 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 | blockPtr->nextBlock = NULL; } } UnlockBucket(cachePtr, bucket); } if (cachePtr->buckets[bucket].numFree == 0) { size_t size; /* * If no blocks could be moved from shared, first look for a larger * block in this cache to split up. */ blockPtr = NULL; |
︙ | ︙ |
Changes to generic/tclTimer.c.
︙ | ︙ | |||
213 214 215 216 217 218 219 | TimerExitProc( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { | | | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | TimerExitProc( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { TimerHandler *timerHandlerPtr; timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; while (timerHandlerPtr != NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; ckfree(timerHandlerPtr); timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; } |
︙ | ︙ | |||
290 291 292 293 294 295 296 | Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData) { | | | 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 | Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData) { TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); timerHandlerPtr = ckalloc(sizeof(TimerHandler)); /* * Fill in fields for the event. */ |
︙ | ︙ | |||
351 352 353 354 355 356 357 | */ void Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by * Tcl_DeleteTimerHandler. */ { | | | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | */ void Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by * Tcl_DeleteTimerHandler. */ { TimerHandler *timerHandlerPtr, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { return; } for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; |
︙ | ︙ | |||
617 618 619 620 621 622 623 | */ void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { | | | 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 | */ void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); idlePtr = ckalloc(sizeof(IdleHandler)); idlePtr->proc = proc; idlePtr->clientData = clientData; idlePtr->generation = tsdPtr->idleGeneration; |
︙ | ︙ | |||
661 662 663 664 665 666 667 | */ void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { | | | 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 | */ void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr, *prevPtr; IdleHandler *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { while ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { |
︙ | ︙ |
Changes to generic/tclTrace.c.
︙ | ︙ | |||
132 133 134 135 136 137 138 | static int StringTraceProc(ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *const objv[]); static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); static int TraceVarEx(Tcl_Interp *interp, const char *part1, | | | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | static int StringTraceProc(ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *const objv[]); static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); static int TraceVarEx(Tcl_Interp *interp, const char *part1, const char *part2, VarTrace *tracePtr); /* * The following structure holds the client data for string-based * trace procs */ typedef struct { |
︙ | ︙ | |||
1045 1046 1047 1048 1049 1050 1051 | Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Command *cmdPtr; | | | 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 | Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Command *cmdPtr; CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return NULL; } |
︙ | ︙ | |||
1110 1111 1112 1113 1114 1115 1116 | * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; | | | 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 | * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return TCL_ERROR; } |
︙ | ︙ | |||
1173 1174 1175 1176 1177 1178 1179 | const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { | | | 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 | const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { CommandTrace *tracePtr; CommandTrace *prevPtr; Command *cmdPtr; Interp *iPtr = (Interp *) interp; ActiveCommandTrace *activePtr; int hasExecTraces = 0; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, |
︙ | ︙ | |||
1668 1669 1670 1671 1672 1673 1674 | * *---------------------------------------------------------------------- */ static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ | | | | 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 | * *---------------------------------------------------------------------- */ static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ Trace *tracePtr, /* Describes the trace function to call. */ Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ int numChars, /* The number of characters in the command's * source. */ int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; char *commandCopy; int traceCode; /* |
︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 | * string in startLevel and startCmd so that we can delete this * interpreter trace when it reaches the end of this proc. */ if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { | | | 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 | * string in startLevel and startCmd so that we can delete this * interpreter trace when it reaches the end of this proc. */ if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { size_t len = strlen(command) + 1; tcmdPtr->startLevel = level; tcmdPtr->startCmd = ckalloc(len); memcpy(tcmdPtr->startCmd, command, len); tcmdPtr->refCount++; tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, |
︙ | ︙ | |||
2061 2062 2063 2064 2065 2066 2067 | Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } Tcl_DStringFree(&cmd); } } if (destroy && result != NULL) { | | | 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 | Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } Tcl_DStringFree(&cmd); } } if (destroy && result != NULL) { Tcl_Obj *errMsgObj = (Tcl_Obj *) result; Tcl_DecrRefCount(errMsgObj); result = NULL; } return result; } |
︙ | ︙ | |||
2138 2139 2140 2141 2142 2143 2144 | int level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ ClientData clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { | | | | 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 | int level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ ClientData clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { Trace *tracePtr; Interp *iPtr = (Interp *) interp; /* * Test if this trace allows inline compilation of commands. */ if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) { if (iPtr->tracesForbiddingInline == 0) { |
︙ | ︙ | |||
2338 2339 2340 2341 2342 2343 2344 | Tcl_DeleteTrace( Tcl_Interp *interp, /* Interpreter that contains trace. */ Tcl_Trace trace) /* Token for trace (returned previously by * Tcl_CreateTrace). */ { Interp *iPtr = (Interp *) interp; Trace *prevPtr, *tracePtr = (Trace *) trace; | | | 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 | Tcl_DeleteTrace( Tcl_Interp *interp, /* Interpreter that contains trace. */ Tcl_Trace trace) /* Token for trace (returned previously by * Tcl_CreateTrace). */ { Interp *iPtr = (Interp *) interp; Trace *prevPtr, *tracePtr = (Trace *) trace; Trace **tracePtr2 = &iPtr->tracePtr; ActiveInterpTrace *activePtr; /* * Locate the trace entry in the interpreter's trace list, and remove it * from the list. */ |
︙ | ︙ | |||
2530 2531 2532 2533 2534 2535 2536 | * *---------------------------------------------------------------------- */ int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ | | | 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 | * *---------------------------------------------------------------------- */ int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, /* Variable's two-part name. */ int flags, /* Flags passed to trace functions: indicates * what's happening to variable, plus maybe |
︙ | ︙ | |||
2564 2565 2566 2567 2568 2569 2570 | return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ | | | | 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 | return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ const char *part1, const char *part2, /* Variable's two-part name. */ int flags, /* Flags passed to trace functions: indicates * what's happening to variable, plus maybe * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */ int leaveErrMsg) /* If true, and one of the traces indicates an * error, then leave an error message and * stack trace information in *iPTr. */ { VarTrace *tracePtr; ActiveVarTrace active; char *result; const char *openParen, *p; Tcl_DString nameCopy; int copiedName; int code = TCL_OK; int disposeFlags = 0; |
︙ | ︙ | |||
2907 2908 2909 2910 2911 2912 2913 | int flags, /* OR-ed collection of bits describing current * trace, including any of TCL_TRACE_READS, * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { | | | 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 | int flags, /* OR-ed collection of bits describing current * trace, including any of TCL_TRACE_READS, * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; ActiveVarTrace *activePtr; int flagMask, allFlags = 0; Tcl_HashEntry *hPtr; |
︙ | ︙ | |||
3099 3100 3101 3102 3103 3104 3105 | /* * Find the relevant trace, if any, and return its clientData. */ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); if (hPtr) { | | | 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 | /* * Find the relevant trace, if any, and return its clientData. */ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); if (hPtr) { VarTrace *tracePtr = Tcl_GetHashValue(hPtr); if (prevClientData != NULL) { for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { if ((tracePtr->clientData == prevClientData) && (tracePtr->traceProc == proc)) { tracePtr = tracePtr->nextPtr; break; |
︙ | ︙ | |||
3197 3198 3199 3200 3201 3202 3203 | * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { | | | 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 | * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; int result; tracePtr = ckalloc(sizeof(VarTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags; |
︙ | ︙ | |||
3242 3243 3244 3245 3246 3247 3248 | TraceVarEx( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ const char *part1, /* Name of scalar variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ | | | 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 | TraceVarEx( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ const char *part1, /* Name of scalar variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ VarTrace *tracePtr)/* Structure containing flags, traceProc and * clientData fields. Others should be left * blank. Will be ckfree()d (eventually) if * this function returns TCL_OK, and up to * caller to free if this function returns * TCL_ERROR. */ { Interp *iPtr = (Interp *) interp; |
︙ | ︙ |
Changes to generic/tclUtf.c.
︙ | ︙ | |||
217 218 219 220 221 222 223 224 225 | * * Side effects: * None. * *--------------------------------------------------------------------------- */ char * Tcl_UniCharToUtfDString( | > | | < | | > > > > > > > > > > > < < | < < < < < < < < < < < | | | < | | > > > > > > > > > > > > | | 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 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 | * * Side effects: * None. * *--------------------------------------------------------------------------- */ #undef Tcl_UniCharToUtfDString char * Tcl_UniCharToUtfDString( const int *uniStr, /* Unicode string to convert to UTF-8. */ int uniLength, /* Length of Unicode string. */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { const int *w, *wEnd; char *p, *string; int oldLength; /* * UTF-8 string length in bytes will be <= Unicode string length * 4. */ if (uniStr == NULL) { return NULL; } if (uniLength < 0) { uniLength = 0; w = uniStr; while (*w != '\0') { uniLength++; w++; } } oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; wEnd = uniStr + uniLength; for (w = uniStr; w < wEnd; ) { p += Tcl_UniCharToUtf(*w, p); w++; } Tcl_DStringSetLength(dsPtr, oldLength + (p - string)); return string; } char * Tcl_Char16ToUtfDString( const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */ int uniLength, /* Length of Utf-16 string. */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { const unsigned short *w, *wEnd; char *p, *string; int oldLength, len = 1; /* * UTF-8 string length in bytes will be <= Utf16 string length * 3. */ if (uniStr == NULL) { return NULL; } if (uniLength < 0) { uniLength = 0; w = uniStr; while (*w != '\0') { uniLength++; w++; } } oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 3); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; wEnd = uniStr + uniLength; for (w = uniStr; w < wEnd; ) { if (!len && ((*w & 0xFC00) != 0xDC00)) { /* Special case for handling high surrogates. */ |
︙ | ︙ | |||
303 304 305 306 307 308 309 | /* Special case for handling high surrogates. */ p += Tcl_UniCharToUtf(-1, p); } Tcl_DStringSetLength(dsPtr, oldLength + (p - string)); return string; } | < | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 | /* Special case for handling high surrogates. */ p += Tcl_UniCharToUtf(-1, p); } Tcl_DStringSetLength(dsPtr, oldLength + (p - string)); return string; } /* *--------------------------------------------------------------------------- * * Tcl_UtfToUniChar -- * * Extract the Tcl_UniChar represented by the UTF-8 string. Bad UTF-8 * sequences are converted to valid Tcl_UniChars and processing |
︙ | ︙ | |||
346 347 348 349 350 351 352 353 354 | static const unsigned short cp1252[32] = { 0x20ac, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021, 0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F, 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014, 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; int Tcl_UtfToUniChar( | > | | | < < < < < < < < < < < < < < | 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 | static const unsigned short cp1252[32] = { 0x20ac, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021, 0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F, 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014, 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; #undef Tcl_UtfToUniChar int Tcl_UtfToUniChar( const char *src, /* The UTF-8 string. */ int *chPtr)/* Filled with the unsigned int represented by * the UTF-8 string. */ { int byte; /* * Unroll 1 to 4 byte UTF-8 sequences. */ byte = *((unsigned char *) src); if (byte < 0xC0) { /* * Handles properly formed UTF-8 characters between 0x01 and 0x7F. * Treats naked trail bytes 0x80 to 0x9F as valid characters from * the cp1252 table. See: <https://en.wikipedia.org/wiki/UTF-8> * Also treats \0 and other naked trail bytes 0xA0 to 0xBF as valid * characters representing themselves. */ if ((unsigned)(byte-0x80) < (unsigned)0x20) { *chPtr = cp1252[byte-0x80]; } else { *chPtr = byte; } return 1; } else if (byte < 0xE0) { |
︙ | ︙ | |||
427 428 429 430 431 432 433 | */ } else if (byte < 0xF8) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ | < < < < < < < < < < < < < | | | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 | */ } else if (byte < 0xF8) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ *chPtr = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12) | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)); if ((unsigned)(*chPtr - 0x10000) <= 0xFFFFF) { return 4; } } /* * A four-byte-character lead-byte not followed by three trail-bytes * represents itself. */ } *chPtr = byte; return 1; } int Tcl_UtfToChar16( const char *src, /* The UTF-8 string. */ unsigned short *chPtr)/* Filled with the unsigned short represented by * the UTF-8 string. */ { unsigned short byte; /* * Unroll 1 to 4 byte UTF-8 sequences. */ byte = *((unsigned char *) src); if (byte < 0xC0) { |
︙ | ︙ | |||
536 537 538 539 540 541 542 | */ } else if (byte < 0xF8) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ | | < | > | > > > | | | | | < | > | > > > | | | | < | 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 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 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 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 | */ } else if (byte < 0xF8) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ unsigned short high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2) | ((src[2] & 0x3F) >> 4)) - 0x40; if (high >= 0x400) { /* out of range, < 0x10000 or > 0x10ffff */ } else { /* produce high surrogate, advance source pointer */ *chPtr = 0xD800 + high; return 1; } } /* * A four-byte-character lead-byte not followed by three trail-bytes * represents itself. */ } *chPtr = byte; return 1; } /* *--------------------------------------------------------------------------- * * Tcl_UtfToUniCharDString -- * * Convert the UTF-8 string to Unicode. * * Results: * The return value is a pointer to the Unicode representation of the * UTF-8 string. Storage for the return value is appended to the end of * dsPtr. The Unicode string is terminated with a Unicode NULL character. * * Side effects: * None. * *--------------------------------------------------------------------------- */ #undef Tcl_UtfToUniCharDString int * Tcl_UtfToUniCharDString( const char *src, /* UTF-8 string to convert to Unicode. */ int length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized * DString. */ { int ch = 0, *w, *wString; const char *p, *end; int oldLength; if (src == NULL) { return NULL; } if (length < 0) { length = strlen(src); } /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in * bytes. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + ((length + 1) * sizeof(int))); wString = (int *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; p = src; end = src + length - 4; while (p < end) { p += Tcl_UtfToUniChar(p, &ch); *w++ = ch; } end += 4; while (p < end) { if (Tcl_UtfCharComplete(p, end-p)) { p += Tcl_UtfToUniChar(p, &ch); } else { ch = UCHAR(*p++); } *w++ = ch; } *w = '\0'; Tcl_DStringSetLength(dsPtr, oldLength + ((char *) w - (char *) wString)); return wString; } unsigned short * Tcl_UtfToChar16DString( const char *src, /* UTF-8 string to convert to Unicode. */ int length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized * DString. */ { unsigned short ch = 0; unsigned short *w, *wString; const char *p, *end; int oldLength; if (src == NULL) { return NULL; } if (length < 0) { length = strlen(src); } /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in * bytes. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + ((length + 1) * sizeof(unsigned short))); wString = (unsigned short *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; p = src; end = src + length - 4; while (p < end) { p += Tcl_UtfToChar16(p, &ch); *w++ = ch; } end += 4; while (p < end) { if (Tcl_UtfCharComplete(p, end-p)) { p += Tcl_UtfToChar16(p, &ch); } else { ch = UCHAR(*p++); } *w++ = ch; } *w = '\0'; Tcl_DStringSetLength(dsPtr, oldLength + ((char *) w - (char *) wString)); return wString; } /* *--------------------------------------------------------------------------- * * Tcl_UtfCharComplete -- * * Determine if the UTF-8 string of the given length is long enough to be * decoded by Tcl_UtfToUniChar(). This does not ensure that the UTF-8 |
︙ | ︙ | |||
727 728 729 730 731 732 733 | * None. * *--------------------------------------------------------------------------- */ int Tcl_NumUtfChars( | | | | | 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 | * None. * *--------------------------------------------------------------------------- */ int Tcl_NumUtfChars( const char *src, /* The UTF-8 string to measure. */ int length) /* The length of the string in bytes, or -1 * for strlen(string). */ { Tcl_UniChar ch = 0; int i = 0; /* * The separate implementations are faster. * * Since this is a time-sensitive function, we also do the check for the * single-byte char case specially. */ if (length < 0) { while (*src != '\0') { src += TclUtfToUniChar(src, &ch); i++; } if (i < 0) i = INT_MAX; /* Bug [2738427] */ } else { const char *endPtr = src + length - 4; while (src < endPtr) { src += TclUtfToUniChar(src, &ch); i++; } endPtr += 4; while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) { |
︙ | ︙ | |||
964 965 966 967 968 969 970 | * None. * *--------------------------------------------------------------------------- */ int Tcl_UniCharAtIndex( | | | | 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 | * None. * *--------------------------------------------------------------------------- */ int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; #if TCL_UTF_MAX <= 4 int len = 0; #endif |
︙ | ︙ | |||
1012 1013 1014 1015 1016 1017 1018 | * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( | | | | 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 | * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int len = 0; while (index-- > 0) { len = TclUtfToUniChar(src, &ch); src += len; |
︙ | ︙ | |||
1040 1041 1042 1043 1044 1045 1046 | * * Tcl_UtfBackslash -- * * Figure out how to handle a backslash sequence. * * Results: * Stores the bytes represented by the backslash sequence in dst and | | | 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 | * * Tcl_UtfBackslash -- * * Figure out how to handle a backslash sequence. * * Results: * Stores the bytes represented by the backslash sequence in dst and * returns the number of bytes written to dst. At most 4 bytes * are written to dst; dst must have been large enough to accept those * bytes. If readPtr isn't NULL then it is filled in with a count of the * number of bytes in the backslash sequence. * * Side effects: * The maximum number of bytes it takes to represent a Unicode character * in UTF-8 is guaranteed to be less than the number of bytes used to |
︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 | { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes * fine in the strcmp manner. */ | | | 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 | { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes * fine in the strcmp manner. */ int result = 0; for ( ; numBytes != 0; numBytes--, cs++, ct++) { if (*cs != *ct) { result = UCHAR(*cs) - UCHAR(*ct); break; } } |
︙ | ︙ | |||
2147 2148 2149 2150 2151 2152 2153 | * quickly if the next char in the pattern isn't a special * character */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*uniStr && (p != *uniStr) | | | 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 | * quickly if the next char in the pattern isn't a special * character */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*uniStr && (p != *uniStr) && (p != Tcl_UniCharToLower(*uniStr))) { uniStr++; } } else { while (*uniStr && (p != *uniStr)) { uniStr++; } } |
︙ | ︙ | |||
2187 2188 2189 2190 2191 2192 2193 | * characters separated by "-"). */ if (p == '[') { Tcl_UniChar startChar, endChar; uniPattern++; | | | | | 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 | * characters separated by "-"). */ if (p == '[') { Tcl_UniChar startChar, endChar; uniPattern++; ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr); uniStr++; while (1) { if ((*uniPattern == ']') || (*uniPattern == 0)) { return 0; } startChar = (nocase ? Tcl_UniCharToLower(*uniPattern) : *uniPattern); uniPattern++; if (*uniPattern == '-') { uniPattern++; if (*uniPattern == 0) { return 0; } endChar = (nocase ? Tcl_UniCharToLower(*uniPattern) : *uniPattern); uniPattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* * Matches ranges of form [a-z] or [z-a]. */ |
︙ | ︙ | |||
2339 2340 2341 2342 2343 2344 2345 | * quickly if the next char in the pattern isn't a special * character. */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while ((string < stringEnd) && (p != *string) | | | 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 | * quickly if the next char in the pattern isn't a special * character. */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while ((string < stringEnd) && (p != *string) && (p != Tcl_UniCharToLower(*string))) { string++; } } else { while ((string < stringEnd) && (p != *string)) { string++; } } |
︙ | ︙ | |||
2380 2381 2382 2383 2384 2385 2386 | * characters separated by "-"). */ if (p == '[') { Tcl_UniChar ch1, startChar, endChar; pattern++; | | | | | 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 | * characters separated by "-"). */ if (p == '[') { Tcl_UniChar ch1, startChar, endChar; pattern++; ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string); string++; while (1) { if ((*pattern == ']') || (pattern == patternEnd)) { return 0; } startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern); pattern++; if (*pattern == '-') { pattern++; if (pattern == patternEnd) { return 0; } endChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern); pattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* * Matches ranges of form [a-z] or [z-a]. */ |
︙ | ︙ |
Changes to generic/tclUtil.c.
︙ | ︙ | |||
939 940 941 942 943 944 945 | * None. * *---------------------------------------------------------------------- */ int Tcl_ScanElement( | | | | 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 | * None. * *---------------------------------------------------------------------- */ int Tcl_ScanElement( const char *src, /* String to convert to list element. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertElement( | | | | | 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1349 1350 1351 1352 1353 1354 1355 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertCountedElement( | | | 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertCountedElement( const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { int numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; |
︙ | ︙ | |||
1382 1383 1384 1385 1386 1387 1388 | * None. * *---------------------------------------------------------------------- */ int TclConvertElement( | | | 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 | * None. * *---------------------------------------------------------------------- */ int TclConvertElement( const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { int conversion = flags & CONVERT_MASK; char *p = dst; |
︙ | ︙ | |||
2300 2301 2302 2303 2304 2305 2306 | * character */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*str) { charLen = TclUtfToUniChar(str, &ch1); | | | 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 | * character */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*str) { charLen = TclUtfToUniChar(str, &ch1); if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) { break; } str += charLen; } } else { /* * There's no point in trying to make this code |
︙ | ︙ | |||
4188 4189 4190 4191 4192 4193 4194 | int TclCheckBadOctal( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ const char *value) /* String to check. */ { | | | 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 | int TclCheckBadOctal( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ const char *value) /* String to check. */ { const char *p = value; /* * A frequent mistake is invalid octal values due to an unwanted leading * zero. Try to generate a meaningful error message. */ while (TclIsSpaceProc(*p)) { |
︙ | ︙ | |||
4395 4396 4397 4398 4399 4400 4401 | * loss of the intrep. Increment newValue refCount early to handle case * where we set a PGV to itself. */ Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); | | | 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 | * loss of the intrep. Increment newValue refCount early to handle case * where we set a PGV to itself. */ Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_SetHashValue(hPtr, newValue); Tcl_MutexUnlock(&pgvPtr->mutex); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
4455 4456 4457 4458 4459 4460 4461 | pgvPtr->encoding = current; Tcl_MutexUnlock(&pgvPtr->mutex); } else { Tcl_FreeEncoding(current); } } cacheMap = GetThreadHash(&pgvPtr->key); | | | 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 | pgvPtr->encoding = current; Tcl_MutexUnlock(&pgvPtr->mutex); } else { Tcl_FreeEncoding(current); } } cacheMap = GetThreadHash(&pgvPtr->key); hPtr = Tcl_FindHashEntry(cacheMap, INT2PTR(epoch)); if (NULL == hPtr) { int dummy; /* * No cache for the current epoch - must be a new one. * * First, clear the cacheMap, as anything in it must refer to some |
︙ | ︙ | |||
4488 4489 4490 4491 4492 4493 4494 | /* * Store a copy of the shared value in our epoch-indexed cache. */ value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, | | | 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 | /* * Store a copy of the shared value in our epoch-indexed cache. */ value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); Tcl_SetHashValue(hPtr, value); Tcl_IncrRefCount(value); } return Tcl_GetHashValue(hPtr); } |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
528 529 530 531 532 533 534 | * *---------------------------------------------------------------------- */ Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ | | | 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 | * *---------------------------------------------------------------------- */ Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an * array. Otherwise, this is a full variable * name that could include a parenthesized * array element. */ const char *part2, /* Name of element within array, or NULL. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * and TCL_LEAVE_ERR_MSG bits matter. */ const char *msg, /* Verb to use in error messages, e.g. "read" |
︙ | ︙ | |||
601 602 603 604 605 606 607 | Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this * is set to NULL. */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; | | | 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 | Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this * is set to NULL. */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; Var *varPtr; /* Points to the variable's in-frame Var * structure. */ const char *errMsg = NULL; int index, parsed = 0; int localIndex; Tcl_Obj *namePtr, *arrayPtr, *elem; |
︙ | ︙ | |||
980 981 982 983 984 985 986 | if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; int localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { | | | 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 | if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; int localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { Tcl_Obj *objPtr = *objPtrPtr; if (objPtr) { localNameStr = TclGetStringFromObj(objPtr, &localLen); if ((varLen == localLen) && (varName[0] == localNameStr[0]) && !memcmp(varName, localNameStr, varLen)) { *indexPtr = i; |
︙ | ︙ | |||
1321 1322 1323 1324 1325 1326 1327 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjGetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | | 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjGetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG bits. */ { Var *varPtr, *arrayPtr; |
︙ | ︙ | |||
1419 1420 1421 1422 1423 1424 1425 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Var *varPtr, /* The variable to be read.*/ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and |
︙ | ︙ | |||
1525 1526 1527 1528 1529 1530 1531 | *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_SetObjCmd( ClientData dummy, /* Not used. */ | | | 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 | *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_SetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varValueObj; if (objc == 2) { varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG); |
︙ | ︙ | |||
1749 1750 1751 1752 1753 1754 1755 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjSetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ | | | | 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjSetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *newValuePtr, /* New value for variable. */ int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or * TCL_LEAVE_ERR_MSG. */ |
︙ | ︙ | |||
1989 1990 1991 1992 1993 1994 1995 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrSetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrSetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Var *varPtr, /* Reference to the variable to set. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. NULL if the 'index' * parameter is >= 0 */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element |
︙ | ︙ | |||
2309 2310 2311 2312 2313 2314 2315 | * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { | | | 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 | * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { Tcl_Obj *varValuePtr; if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags, index); if (TclIsVarInHash(varPtr)) { |
︙ | ︙ | |||
2570 2571 2572 2573 2574 2575 2576 | *---------------------------------------------------------------------- */ int TclPtrUnsetVarIdx( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ | | | 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 | *---------------------------------------------------------------------- */ int TclPtrUnsetVarIdx( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ Var *varPtr, /* The variable to be unset. */ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ const int flags, /* OR-ed combination of any of |
︙ | ︙ | |||
2824 2825 2826 2827 2828 2829 2830 | int Tcl_UnsetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 | int Tcl_UnsetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, flags = TCL_LEAVE_ERR_MSG; const char *name; if (objc == 1) { /* * Do nothing if no arguments supplied, so as to match command * documentation. */ |
︙ | ︙ | |||
2893 2894 2895 2896 2897 2898 2899 | Tcl_AppendObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; | | | 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 | Tcl_AppendObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; Tcl_Obj *varValuePtr = NULL; /* Initialized to avoid compiler warning. */ int i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
4949 4950 4951 4952 4953 4954 4955 | Tcl_Interp *interp, /* Interpreter containing the variable. */ Tcl_Var variable, /* Token for the variable returned by a * previous call to Tcl_FindNamespaceVar. */ Tcl_Obj *objPtr) /* Points to the object onto which the * variable's full name is appended. */ { Interp *iPtr = (Interp *) interp; | | | 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 | Tcl_Interp *interp, /* Interpreter containing the variable. */ Tcl_Var variable, /* Token for the variable returned by a * previous call to Tcl_FindNamespaceVar. */ Tcl_Obj *objPtr) /* Points to the object onto which the * variable's full name is appended. */ { Interp *iPtr = (Interp *) interp; Var *varPtr = (Var *) variable; Tcl_Obj *namePtr; Namespace *nsPtr; if (!varPtr || TclIsVarArrayElement(varPtr)) { return; } |
︙ | ︙ | |||
5009 5010 5011 5012 5013 5014 5015 | Tcl_GlobalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; | | | | 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 | Tcl_GlobalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *objPtr, *tailPtr; const char *varName; const char *tail; int result, i; /* * If we are not executing inside a Tcl procedure, just return. */ if (!HasLocalVars(iPtr->varFramePtr)) { |
︙ | ︙ | |||
5406 5407 5408 5409 5410 5411 5412 | * *---------------------------------------------------------------------- */ static void DeleteSearches( Interp *iPtr, | | | 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 | * *---------------------------------------------------------------------- */ static void DeleteSearches( Interp *iPtr, Var *arrayVarPtr) /* Variable whose searches are to be * deleted. */ { ArraySearch *searchPtr, *nextPtr; Tcl_HashEntry *sPtr; if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) { sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr); |
︙ | ︙ | |||
5548 5549 5550 5551 5552 5553 5554 | TclDeleteVars( Interp *iPtr, /* Interpreter to which variables belong. */ TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; | | | 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 | TclDeleteVars( Interp *iPtr, /* Interpreter to which variables belong. */ TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; Var *varPtr; int flags; Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); /* * Determine what flags to pass to the trace callback functions. */ |
︙ | ︙ | |||
5600 5601 5602 5603 5604 5605 5606 | void TclDeleteCompiledLocalVars( Interp *iPtr, /* Interpreter to which variables belong. */ CallFrame *framePtr) /* Procedure call frame containing compiler- * assigned local variables to delete. */ { | | | 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 | void TclDeleteCompiledLocalVars( Interp *iPtr, /* Interpreter to which variables belong. */ CallFrame *framePtr) /* Procedure call frame containing compiler- * assigned local variables to delete. */ { Var *varPtr; int numLocals, i; Tcl_Obj **namePtrPtr; numLocals = framePtr->numCompiledLocals; varPtr = framePtr->compiledLocals; namePtrPtr = &localName(framePtr, 0); for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) { |
︙ | ︙ | |||
5649 5650 5651 5652 5653 5654 5655 | int flags, /* Flags to pass to TclCallVarTraces: * TCL_TRACE_UNSETS and sometimes * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */ int index) { Tcl_HashSearch search; Tcl_HashEntry *tPtr; | | | 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 | int flags, /* Flags to pass to TclCallVarTraces: * TCL_TRACE_UNSETS and sometimes * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */ int index) { Tcl_HashSearch search; Tcl_HashEntry *tPtr; Var *elPtr; ActiveVarTrace *activePtr; Tcl_Obj *objPtr; VarTrace *tracePtr; for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search); elPtr != NULL; elPtr = VarHashNextVar(&search)) { if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) { |
︙ | ︙ | |||
5838 5839 5840 5841 5842 5843 5844 | * Tcl_Obj), or NULL if it is a scalar variable */ static void FreeParsedVarName( Tcl_Obj *objPtr) { | | | | 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 | * Tcl_Obj), or NULL if it is a scalar variable */ static void FreeParsedVarName( Tcl_Obj *objPtr) { Tcl_Obj *arrayPtr, *elem; int parsed; ParsedGetIntRep(objPtr, parsed, arrayPtr, elem); parsed++; /* Silence compiler. */ if (arrayPtr != NULL) { TclDecrRefCount(arrayPtr); TclDecrRefCount(elem); } } static void DupParsedVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { Tcl_Obj *arrayPtr, *elem; int parsed; ParsedGetIntRep(srcPtr, parsed, arrayPtr, elem); parsed++; /* Silence compiler. */ ParsedSetIntRep(dupPtr, arrayPtr, elem); } |
︙ | ︙ | |||
5944 5945 5946 5947 5948 5949 5950 | * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; const char *simpleName; Var *varPtr; | | | 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 | * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; const char *simpleName; Var *varPtr; int search; int result; Tcl_Var var; Tcl_Obj *simpleNamePtr; const char *name = TclGetString(namePtr); /* * If this namespace has a variable resolver, then give it first crack at |
︙ | ︙ | |||
6596 6597 6598 6599 6600 6601 6602 | static int CompareVarKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; | | | | 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 | static int CompareVarKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; const char *p1, *p2; int l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller * * if (objPtr1 == objPtr2) return 1; */ |
︙ | ︙ |
Changes to generic/tclZipfs.c.
︙ | ︙ | |||
395 396 397 398 399 400 401 | static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); /* * Define the ZIP filesystem dispatch table. */ | < < | | 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 | static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); /* * Define the ZIP filesystem dispatch table. */ static const Tcl_Filesystem zipfsFilesystem = { "zipfs", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_2, ZipFSPathInFilesystemProc, NULL, /* dupInternalRepProc */ NULL, /* freeInternalRepProc */ NULL, /* internalToNormalizedProc */ |
︙ | ︙ | |||
4725 4726 4727 4728 4729 4730 4731 | * Side effects: * Initializes this module if not already initialized, and adds module * related commands to the given interpreter. * *------------------------------------------------------------------------- */ | | | 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 | * Side effects: * Initializes this module if not already initialized, and adds module * related commands to the given interpreter. * *------------------------------------------------------------------------- */ int TclZipfs_Init( Tcl_Interp *interp) /* Current interpreter. */ { #ifdef HAVE_ZLIB static const EnsembleImplMap initMap[] = { {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 1}, {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 1}, |
︙ | ︙ | |||
4925 4926 4927 4928 4929 4930 4931 | * If the first argument is "install", run the supplied installer * script. */ #ifdef _WIN32 Tcl_DString ds; | > | | 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 | * If the first argument is "install", run the supplied installer * script. */ #ifdef _WIN32 Tcl_DString ds; Tcl_DStringInit(&ds); archive = Tcl_WCharToUtfDString((*argvPtr)[1], -1, &ds); #else /* !_WIN32 */ archive = (*argvPtr)[1]; #endif /* _WIN32 */ if (strcmp(archive, "install") == 0) { Tcl_Obj *vfsInitScript; /* |
︙ | ︙ |
Changes to library/dde/pkgIndex.tcl.
|
| | | | 1 2 3 4 5 6 7 | if {![package vsatisfies [package provide Tcl] 8.5-]} return if {[info sharedlibextension] != ".dll"} return if {[::tcl::pkgconfig get debug]} { package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde] } else { package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde] } |
Changes to library/http/effective_tld_names.txt.gz.
cannot compute difference between binary files
Changes to library/init.tcl.
︙ | ︙ | |||
612 613 614 615 616 617 618 | return [set auto_execs($name) [list $file]] } } return "" } set path "[file dirname [info nameof]];.;" | | > > | 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 | return [set auto_execs($name) [list $file]] } } return "" } set path "[file dirname [info nameof]];.;" if {[info exists env(SystemRoot)]} { set windir $env(SystemRoot) } elseif {[info exists env(WINDIR)]} { set windir $env(WINDIR) } if {[info exists windir]} { append path "$windir/system32;$windir/system;$windir;" } foreach var {PATH Path path} { |
︙ | ︙ |
Changes to library/manifest.txt.
1 2 3 4 5 6 7 8 9 10 11 12 | ### # Package manifest for all Tcl packages included in the /library file system ### apply {{dir} { set ::test [info script] set isafe [interp issafe] foreach {safe package version file} { 0 http 2.9.0 {http http.tcl} 1 msgcat 1.7.0 {msgcat msgcat.tcl} 1 opt 0.4.7 {opt optparse.tcl} 0 platform 1.0.14 {platform platform.tcl} 0 platform::shell 1.1.4 {platform shell.tcl} | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | ### # Package manifest for all Tcl packages included in the /library file system ### apply {{dir} { set ::test [info script] set isafe [interp issafe] foreach {safe package version file} { 0 http 2.9.0 {http http.tcl} 1 msgcat 1.7.0 {msgcat msgcat.tcl} 1 opt 0.4.7 {opt optparse.tcl} 0 platform 1.0.14 {platform platform.tcl} 0 platform::shell 1.1.4 {platform shell.tcl} 1 tcltest 2.5.1 {tcltest tcltest.tcl} } { if {$isafe && !$safe} continue package ifneeded $package $version [list source [file join $dir {*}$file]] } }} $dir |
Changes to library/reg/pkgIndex.tcl.
|
| | | | 1 2 3 4 5 6 7 8 9 | if {![package vsatisfies [package provide Tcl] 8.5-]} return if {[info sharedlibextension] != ".dll"} return if {[::tcl::pkgconfig get debug]} { package ifneeded registry 1.3.3 \ [list load [file join $dir tclreg13g.dll] registry] } else { package ifneeded registry 1.3.3 \ [list load [file join $dir tclreg13.dll] registry] } |
Changes to library/tcltest/pkgIndex.tcl.
1 2 3 4 5 6 7 8 9 10 11 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} | | | 1 2 3 4 5 6 7 8 9 10 11 12 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded tcltest 2.5.1 [list source [file join $dir tcltest.tcl]] |
Changes to library/tcltest/tcltest.tcl.
︙ | ︙ | |||
18 19 20 21 22 23 24 | package require Tcl 8.5- ;# -verbose line uses [info frame] namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | package require Tcl 8.5- ;# -verbose line uses [info frame] namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. variable Version 2.5.1 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] variable patchLevel [info patchlevel] |
︙ | ︙ | |||
3068 3069 3070 3071 3072 3073 3074 | } } if {![file isfile $fullName]} { DebugDo 1 { Warn "removeFile removing \"$fullName\":\n not a file" } } | | > > > > > | 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 | } } if {![file isfile $fullName]} { DebugDo 1 { Warn "removeFile removing \"$fullName\":\n not a file" } } if {[catch {file delete -- $fullName} msg ]} { DebugDo 1 { Warn "removeFile removing \"$fullName\":\n failed: $msg" } } return } # tcltest::makeDirectory -- # # Create a new dir with the name <name>. # # If this dir hasn't been created via makeDirectory since the last time |
︙ | ︙ |
Changes to library/tm.tcl.
︙ | ︙ | |||
307 308 309 310 311 312 313 | # # Sideeffects # May add paths to the list of defaults. proc ::tcl::tm::Defaults {} { global env tcl_platform | | | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | # # Sideeffects # May add paths to the list of defaults. proc ::tcl::tm::Defaults {} { global env tcl_platform regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor set exe [file normalize [info nameofexecutable]] # Note that we're using [::list], not [list] because [list] means # something other than [::list] in this namespace. roots [::list \ [file dirname [info library]] \ [file join [file dirname [file dirname $exe]] lib] \ |
︙ | ︙ | |||
350 351 352 353 354 355 356 | # Results # No result. # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { | | | 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 | # Results # No result. # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { set px [file join $p ${major}.${n}] if {![interp issafe]} {set px [file normalize $px]} path add $px } |
︙ | ︙ |
Changes to library/tzdata/Africa/Casablanca.
︙ | ︙ | |||
93 94 95 96 97 98 99 100 | {2049933600 3600 0 +01} {2077149600 0 1 +01} {2080173600 3600 0 +01} {2107994400 0 1 +01} {2111018400 3600 0 +01} {2138234400 0 1 +01} {2141863200 3600 0 +01} } | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 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 192 193 194 195 196 197 198 199 200 201 202 | {2049933600 3600 0 +01} {2077149600 0 1 +01} {2080173600 3600 0 +01} {2107994400 0 1 +01} {2111018400 3600 0 +01} {2138234400 0 1 +01} {2141863200 3600 0 +01} {2169079200 0 1 +01} {2172103200 3600 0 +01} {2199924000 0 1 +01} {2202948000 3600 0 +01} {2230164000 0 1 +01} {2233792800 3600 0 +01} {2261008800 0 1 +01} {2264032800 3600 0 +01} {2291248800 0 1 +01} {2294877600 3600 0 +01} {2322093600 0 1 +01} {2325117600 3600 0 +01} {2352938400 0 1 +01} {2355962400 3600 0 +01} {2383178400 0 1 +01} {2386807200 3600 0 +01} {2414023200 0 1 +01} {2417047200 3600 0 +01} {2444868000 0 1 +01} {2447892000 3600 0 +01} {2475108000 0 1 +01} {2478736800 3600 0 +01} {2505952800 0 1 +01} {2508976800 3600 0 +01} {2536192800 0 1 +01} {2539821600 3600 0 +01} {2567037600 0 1 +01} {2570061600 3600 0 +01} {2597882400 0 1 +01} {2600906400 3600 0 +01} {2628122400 0 1 +01} {2631751200 3600 0 +01} {2658967200 0 1 +01} {2661991200 3600 0 +01} {2689812000 0 1 +01} {2692836000 3600 0 +01} {2720052000 0 1 +01} {2723680800 3600 0 +01} {2750896800 0 1 +01} {2753920800 3600 0 +01} {2781136800 0 1 +01} {2784765600 3600 0 +01} {2811981600 0 1 +01} {2815005600 3600 0 +01} {2842826400 0 1 +01} {2845850400 3600 0 +01} {2873066400 0 1 +01} {2876695200 3600 0 +01} {2903911200 0 1 +01} {2906935200 3600 0 +01} {2934756000 0 1 +01} {2937780000 3600 0 +01} {2964996000 0 1 +01} {2968020000 3600 0 +01} {2995840800 0 1 +01} {2998864800 3600 0 +01} {3026080800 0 1 +01} {3029709600 3600 0 +01} {3056925600 0 1 +01} {3059949600 3600 0 +01} {3087770400 0 1 +01} {3090794400 3600 0 +01} {3118010400 0 1 +01} {3121639200 3600 0 +01} {3148855200 0 1 +01} {3151879200 3600 0 +01} {3179700000 0 1 +01} {3182724000 3600 0 +01} {3209940000 0 1 +01} {3212964000 3600 0 +01} {3240784800 0 1 +01} {3243808800 3600 0 +01} {3271024800 0 1 +01} {3274653600 3600 0 +01} {3301869600 0 1 +01} {3304893600 3600 0 +01} {3332714400 0 1 +01} {3335738400 3600 0 +01} {3362954400 0 1 +01} {3366583200 3600 0 +01} {3393799200 0 1 +01} {3396823200 3600 0 +01} {3424644000 0 1 +01} {3427668000 3600 0 +01} {3454884000 0 1 +01} {3457908000 3600 0 +01} {3485728800 0 1 +01} {3488752800 3600 0 +01} {3515968800 0 1 +01} {3519597600 3600 0 +01} {3546813600 0 1 +01} {3549837600 3600 0 +01} {3577658400 0 1 +01} {3580682400 3600 0 +01} {3607898400 0 1 +01} {3611527200 3600 0 +01} {3638743200 0 1 +01} {3641767200 3600 0 +01} {3669588000 0 1 +01} {3672612000 3600 0 +01} {3699828000 0 1 +01} {3702852000 3600 0 +01} } |
Changes to library/tzdata/Africa/El_Aaiun.
︙ | ︙ | |||
82 83 84 85 86 87 88 89 | {2049933600 3600 0 +01} {2077149600 0 1 +01} {2080173600 3600 0 +01} {2107994400 0 1 +01} {2111018400 3600 0 +01} {2138234400 0 1 +01} {2141863200 3600 0 +01} } | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 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 | {2049933600 3600 0 +01} {2077149600 0 1 +01} {2080173600 3600 0 +01} {2107994400 0 1 +01} {2111018400 3600 0 +01} {2138234400 0 1 +01} {2141863200 3600 0 +01} {2169079200 0 1 +01} {2172103200 3600 0 +01} {2199924000 0 1 +01} {2202948000 3600 0 +01} {2230164000 0 1 +01} {2233792800 3600 0 +01} {2261008800 0 1 +01} {2264032800 3600 0 +01} {2291248800 0 1 +01} {2294877600 3600 0 +01} {2322093600 0 1 +01} {2325117600 3600 0 +01} {2352938400 0 1 +01} {2355962400 3600 0 +01} {2383178400 0 1 +01} {2386807200 3600 0 +01} {2414023200 0 1 +01} {2417047200 3600 0 +01} {2444868000 0 1 +01} {2447892000 3600 0 +01} {2475108000 0 1 +01} {2478736800 3600 0 +01} {2505952800 0 1 +01} {2508976800 3600 0 +01} {2536192800 0 1 +01} {2539821600 3600 0 +01} {2567037600 0 1 +01} {2570061600 3600 0 +01} {2597882400 0 1 +01} {2600906400 3600 0 +01} {2628122400 0 1 +01} {2631751200 3600 0 +01} {2658967200 0 1 +01} {2661991200 3600 0 +01} {2689812000 0 1 +01} {2692836000 3600 0 +01} {2720052000 0 1 +01} {2723680800 3600 0 +01} {2750896800 0 1 +01} {2753920800 3600 0 +01} {2781136800 0 1 +01} {2784765600 3600 0 +01} {2811981600 0 1 +01} {2815005600 3600 0 +01} {2842826400 0 1 +01} {2845850400 3600 0 +01} {2873066400 0 1 +01} {2876695200 3600 0 +01} {2903911200 0 1 +01} {2906935200 3600 0 +01} {2934756000 0 1 +01} {2937780000 3600 0 +01} {2964996000 0 1 +01} {2968020000 3600 0 +01} {2995840800 0 1 +01} {2998864800 3600 0 +01} {3026080800 0 1 +01} {3029709600 3600 0 +01} {3056925600 0 1 +01} {3059949600 3600 0 +01} {3087770400 0 1 +01} {3090794400 3600 0 +01} {3118010400 0 1 +01} {3121639200 3600 0 +01} {3148855200 0 1 +01} {3151879200 3600 0 +01} {3179700000 0 1 +01} {3182724000 3600 0 +01} {3209940000 0 1 +01} {3212964000 3600 0 +01} {3240784800 0 1 +01} {3243808800 3600 0 +01} {3271024800 0 1 +01} {3274653600 3600 0 +01} {3301869600 0 1 +01} {3304893600 3600 0 +01} {3332714400 0 1 +01} {3335738400 3600 0 +01} {3362954400 0 1 +01} {3366583200 3600 0 +01} {3393799200 0 1 +01} {3396823200 3600 0 +01} {3424644000 0 1 +01} {3427668000 3600 0 +01} {3454884000 0 1 +01} {3457908000 3600 0 +01} {3485728800 0 1 +01} {3488752800 3600 0 +01} {3515968800 0 1 +01} {3519597600 3600 0 +01} {3546813600 0 1 +01} {3549837600 3600 0 +01} {3577658400 0 1 +01} {3580682400 3600 0 +01} {3607898400 0 1 +01} {3611527200 3600 0 +01} {3638743200 0 1 +01} {3641767200 3600 0 +01} {3669588000 0 1 +01} {3672612000 3600 0 +01} {3699828000 0 1 +01} {3702852000 3600 0 +01} } |
Changes to library/tzdata/America/Campo_Grande.
︙ | ︙ | |||
89 90 91 92 93 94 95 | {1456023600 -14400 0 -04} {1476590400 -10800 1 -04} {1487473200 -14400 0 -04} {1508040000 -10800 1 -04} {1518922800 -14400 0 -04} {1541304000 -10800 1 -04} {1550372400 -14400 0 -04} | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 89 90 91 92 93 94 95 96 | {1456023600 -14400 0 -04} {1476590400 -10800 1 -04} {1487473200 -14400 0 -04} {1508040000 -10800 1 -04} {1518922800 -14400 0 -04} {1541304000 -10800 1 -04} {1550372400 -14400 0 -04} } |
Changes to library/tzdata/America/Cuiaba.
︙ | ︙ | |||
89 90 91 92 93 94 95 | {1456023600 -14400 0 -04} {1476590400 -10800 1 -04} {1487473200 -14400 0 -04} {1508040000 -10800 1 -04} {1518922800 -14400 0 -04} {1541304000 -10800 1 -04} {1550372400 -14400 0 -04} | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 89 90 91 92 93 94 95 96 | {1456023600 -14400 0 -04} {1476590400 -10800 1 -04} {1487473200 -14400 0 -04} {1508040000 -10800 1 -04} {1518922800 -14400 0 -04} {1541304000 -10800 1 -04} {1550372400 -14400 0 -04} } |
Changes to library/tzdata/America/Detroit.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # created by tools/tclZIC.tcl - do not edit set TZData(:America/Detroit) { {-9223372036854775808 -19931 0 LMT} {-2051202469 -21600 0 CST} {-1724083200 -18000 0 EST} {-883594800 -18000 0 EST} {-880218000 -14400 1 EWT} {-769395600 -14400 1 EPT} {-765396000 -18000 0 EST} {-757364400 -18000 0 EST} {-684349200 -14400 1 EDT} {-671047200 -18000 0 EST} {94712400 -18000 0 EST} {104914800 -14400 1 EDT} {120636000 -18000 0 EST} {126687600 -14400 1 EDT} {152085600 -18000 0 EST} {157784400 -18000 0 EST} {167814000 -14400 0 EDT} | > > > > > | 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 | # created by tools/tclZIC.tcl - do not edit set TZData(:America/Detroit) { {-9223372036854775808 -19931 0 LMT} {-2051202469 -21600 0 CST} {-1724083200 -18000 0 EST} {-883594800 -18000 0 EST} {-880218000 -14400 1 EWT} {-769395600 -14400 1 EPT} {-765396000 -18000 0 EST} {-757364400 -18000 0 EST} {-684349200 -14400 1 EDT} {-671047200 -18000 0 EST} {-80506740 -14400 0 EDT} {-68666400 -18000 0 EST} {-52938000 -14400 1 EDT} {-37216800 -18000 0 EST} {-31518000 -18000 0 EST} {94712400 -18000 0 EST} {104914800 -14400 1 EDT} {120636000 -18000 0 EST} {126687600 -14400 1 EDT} {152085600 -18000 0 EST} {157784400 -18000 0 EST} {167814000 -14400 0 EDT} |
︙ | ︙ |
Changes to library/tzdata/America/Edmonton.
︙ | ︙ | |||
16 17 18 19 20 21 22 | {-1473001200 -21600 1 MDT} {-1459699200 -25200 0 MST} {-880210800 -21600 1 MWT} {-769395600 -21600 1 MPT} {-765388800 -25200 0 MST} {-715791600 -21600 1 MDT} {-702489600 -25200 0 MST} | < < < < | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | {-1473001200 -21600 1 MDT} {-1459699200 -25200 0 MST} {-880210800 -21600 1 MWT} {-769395600 -21600 1 MPT} {-765388800 -25200 0 MST} {-715791600 -21600 1 MDT} {-702489600 -25200 0 MST} {73472400 -21600 1 MDT} {89193600 -25200 0 MST} {104922000 -21600 1 MDT} {120643200 -25200 0 MST} {136371600 -21600 1 MDT} {152092800 -25200 0 MST} {167821200 -21600 1 MDT} |
︙ | ︙ |
Changes to library/tzdata/America/Indiana/Tell_City.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # created by tools/tclZIC.tcl - do not edit set TZData(:America/Indiana/Tell_City) { {-9223372036854775808 -20823 0 LMT} {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} {-1583686800 -21600 0 CST} {-880214400 -18000 1 CWT} {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} | < < < < < < | | > | > | | 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 | # created by tools/tclZIC.tcl - do not edit set TZData(:America/Indiana/Tell_City) { {-9223372036854775808 -20823 0 LMT} {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} {-1583686800 -21600 0 CST} {-880214400 -18000 1 CWT} {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} {-462996000 -18000 1 CDT} {-450291600 -21600 0 CST} {-431539200 -18000 1 CDT} {-418237200 -21600 0 CST} {-400089600 -18000 1 CDT} {-386787600 -21600 0 CST} {-368640000 -18000 1 CDT} {-355338000 -21600 0 CST} {-337190400 -18000 1 CDT} {-323888400 -21600 0 CST} {-305740800 -18000 1 CDT} {-292438800 -21600 0 CST} {-273686400 -18000 1 CDT} {-257965200 -21600 0 CST} {-242236800 -18000 1 CDT} {-226515600 -21600 0 CST} {-210787200 -18000 1 CDT} {-195066000 -21600 0 CST} {-179337600 -18000 0 EST} {-68662800 -21600 0 CST} {-52934400 -18000 1 CDT} {-37213200 -21600 0 CST} {-21484800 -14400 0 EDT} {-5767200 -18000 0 EST} {9961200 -14400 1 EDT} {25682400 -18000 0 EST} {31554000 -18000 0 EST} {1143961200 -21600 0 CST} {1143964800 -18000 1 CDT} {1162105200 -21600 0 CST} |
︙ | ︙ |
Changes to library/tzdata/America/Kentucky/Louisville.
︙ | ︙ | |||
13 14 15 16 17 18 19 | {-905097600 -18000 1 CDT} {-891795600 -21600 0 CST} {-883591200 -21600 0 CST} {-880214400 -18000 1 CWT} {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} | | | < < < | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | {-905097600 -18000 1 CDT} {-891795600 -21600 0 CST} {-883591200 -21600 0 CST} {-880214400 -18000 1 CWT} {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} {-747251940 -18000 1 CDT} {-744224400 -21600 0 CST} {-620841600 -18000 1 CDT} {-608144400 -21600 0 CST} {-589392000 -18000 1 CDT} {-576090000 -21600 0 CST} {-557942400 -18000 1 CDT} {-544640400 -21600 0 CST} {-526492800 -18000 1 CDT} {-513190800 -21600 0 CST} |
︙ | ︙ | |||
41 42 43 44 45 46 47 | {-368640000 -18000 1 CDT} {-352918800 -21600 0 CST} {-337190400 -18000 1 CDT} {-321469200 -21600 0 CST} {-305740800 -18000 1 CDT} {-289414800 -21600 0 CST} {-273686400 -18000 1 CDT} | | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | {-368640000 -18000 1 CDT} {-352918800 -21600 0 CST} {-337190400 -18000 1 CDT} {-321469200 -21600 0 CST} {-305740800 -18000 1 CDT} {-289414800 -21600 0 CST} {-273686400 -18000 1 CDT} {-266428800 -18000 0 EST} {-63140400 -18000 0 EST} {-52938000 -14400 1 EDT} {-37216800 -18000 0 EST} {-21488400 -14400 1 EDT} {-5767200 -18000 0 EST} {9961200 -14400 1 EDT} {25682400 -18000 0 EST} |
︙ | ︙ |
Changes to library/tzdata/America/Sao_Paulo.
︙ | ︙ | |||
90 91 92 93 94 95 96 | {1456020000 -10800 0 -03} {1476586800 -7200 1 -03} {1487469600 -10800 0 -03} {1508036400 -7200 1 -03} {1518919200 -10800 0 -03} {1541300400 -7200 1 -03} {1550368800 -10800 0 -03} | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 90 91 92 93 94 95 96 97 | {1456020000 -10800 0 -03} {1476586800 -7200 1 -03} {1487469600 -10800 0 -03} {1508036400 -7200 1 -03} {1518919200 -10800 0 -03} {1541300400 -7200 1 -03} {1550368800 -10800 0 -03} } |
Changes to library/tzdata/America/Vancouver.
1 2 3 4 5 6 7 8 9 10 11 | # created by tools/tclZIC.tcl - do not edit set TZData(:America/Vancouver) { {-9223372036854775808 -29548 0 LMT} {-2713880852 -28800 0 PST} {-1632060000 -25200 1 PDT} {-1615129200 -28800 0 PST} {-880207200 -25200 1 PWT} {-769395600 -25200 1 PPT} {-765385200 -28800 0 PST} {-747237600 -25200 1 PDT} | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # created by tools/tclZIC.tcl - do not edit set TZData(:America/Vancouver) { {-9223372036854775808 -29548 0 LMT} {-2713880852 -28800 0 PST} {-1632060000 -25200 1 PDT} {-1615129200 -28800 0 PST} {-880207200 -25200 1 PWT} {-769395600 -25200 1 PPT} {-765385200 -28800 0 PST} {-747237600 -25200 1 PDT} {-733935600 -28800 0 PST} {-715788000 -25200 1 PDT} {-702486000 -28800 0 PST} {-684338400 -25200 1 PDT} {-671036400 -28800 0 PST} {-652888800 -25200 1 PDT} {-639586800 -28800 0 PST} {-620834400 -25200 1 PDT} |
︙ | ︙ |
Changes to library/tzdata/Asia/Gaza.
︙ | ︙ | |||
113 114 115 116 117 118 119 | {1445547600 7200 0 EET} {1458946800 10800 1 EEST} {1477692000 7200 0 EET} {1490396400 10800 1 EEST} {1509141600 7200 0 EET} {1521846000 10800 1 EEST} {1540591200 7200 0 EET} | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 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 192 193 194 195 196 197 198 199 200 201 202 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 | {1445547600 7200 0 EET} {1458946800 10800 1 EEST} {1477692000 7200 0 EET} {1490396400 10800 1 EEST} {1509141600 7200 0 EET} {1521846000 10800 1 EEST} {1540591200 7200 0 EET} {1553810400 10800 1 EEST} {1572040800 7200 0 EET} {1585260000 10800 1 EEST} {1604095200 7200 0 EET} {1616709600 10800 1 EEST} {1635544800 7200 0 EET} {1648159200 10800 1 EEST} {1666994400 7200 0 EET} {1680213600 10800 1 EEST} {1698444000 7200 0 EET} {1711663200 10800 1 EEST} {1729893600 7200 0 EET} {1743112800 10800 1 EEST} {1761343200 7200 0 EET} {1774562400 10800 1 EEST} {1793397600 7200 0 EET} {1806012000 10800 1 EEST} {1824847200 7200 0 EET} {1838066400 10800 1 EEST} {1856296800 7200 0 EET} {1869516000 10800 1 EEST} {1887746400 7200 0 EET} {1900965600 10800 1 EEST} {1919196000 7200 0 EET} {1932415200 10800 1 EEST} {1950645600 7200 0 EET} {1963864800 10800 1 EEST} {1982700000 7200 0 EET} {1995314400 10800 1 EEST} {2014149600 7200 0 EET} {2027368800 10800 1 EEST} {2045599200 7200 0 EET} {2058818400 10800 1 EEST} {2077048800 7200 0 EET} {2090268000 10800 1 EEST} {2108498400 7200 0 EET} {2121717600 10800 1 EEST} {2140552800 7200 0 EET} {2153167200 10800 1 EEST} {2172002400 7200 0 EET} {2184616800 10800 1 EEST} {2203452000 7200 0 EET} {2216671200 10800 1 EEST} {2234901600 7200 0 EET} {2248120800 10800 1 EEST} {2266351200 7200 0 EET} {2279570400 10800 1 EEST} {2297800800 7200 0 EET} {2311020000 10800 1 EEST} {2329855200 7200 0 EET} {2342469600 10800 1 EEST} {2361304800 7200 0 EET} {2374524000 10800 1 EEST} {2392754400 7200 0 EET} {2405973600 10800 1 EEST} {2424204000 7200 0 EET} {2437423200 10800 1 EEST} {2455653600 7200 0 EET} {2468872800 10800 1 EEST} {2487708000 7200 0 EET} {2500322400 10800 1 EEST} {2519157600 7200 0 EET} {2531772000 10800 1 EEST} {2550607200 7200 0 EET} {2563826400 10800 1 EEST} {2582056800 7200 0 EET} {2595276000 10800 1 EEST} {2613506400 7200 0 EET} {2626725600 10800 1 EEST} {2644956000 7200 0 EET} {2658175200 10800 1 EEST} {2677010400 7200 0 EET} {2689624800 10800 1 EEST} {2708460000 7200 0 EET} {2721679200 10800 1 EEST} {2739909600 7200 0 EET} {2753128800 10800 1 EEST} {2771359200 7200 0 EET} {2784578400 10800 1 EEST} {2802808800 7200 0 EET} {2816028000 10800 1 EEST} {2834258400 7200 0 EET} {2847477600 10800 1 EEST} {2866312800 7200 0 EET} {2878927200 10800 1 EEST} {2897762400 7200 0 EET} {2910981600 10800 1 EEST} {2929212000 7200 0 EET} {2942431200 10800 1 EEST} {2960661600 7200 0 EET} {2973880800 10800 1 EEST} {2992111200 7200 0 EET} {3005330400 10800 1 EEST} {3024165600 7200 0 EET} {3036780000 10800 1 EEST} {3055615200 7200 0 EET} {3068229600 10800 1 EEST} {3087064800 7200 0 EET} {3100284000 10800 1 EEST} {3118514400 7200 0 EET} {3131733600 10800 1 EEST} {3149964000 7200 0 EET} {3163183200 10800 1 EEST} {3181413600 7200 0 EET} {3194632800 10800 1 EEST} {3213468000 7200 0 EET} {3226082400 10800 1 EEST} {3244917600 7200 0 EET} {3258136800 10800 1 EEST} {3276367200 7200 0 EET} {3289586400 10800 1 EEST} {3307816800 7200 0 EET} {3321036000 10800 1 EEST} {3339266400 7200 0 EET} {3352485600 10800 1 EEST} {3371320800 7200 0 EET} {3383935200 10800 1 EEST} {3402770400 7200 0 EET} {3415384800 10800 1 EEST} {3434220000 7200 0 EET} {3447439200 10800 1 EEST} {3465669600 7200 0 EET} {3478888800 10800 1 EEST} {3497119200 7200 0 EET} {3510338400 10800 1 EEST} {3528568800 7200 0 EET} {3541788000 10800 1 EEST} {3560623200 7200 0 EET} {3573237600 10800 1 EEST} {3592072800 7200 0 EET} {3605292000 10800 1 EEST} {3623522400 7200 0 EET} {3636741600 10800 1 EEST} {3654972000 7200 0 EET} {3668191200 10800 1 EEST} {3686421600 7200 0 EET} {3699640800 10800 1 EEST} {3717871200 7200 0 EET} {3731090400 10800 1 EEST} {3749925600 7200 0 EET} {3762540000 10800 1 EEST} {3781375200 7200 0 EET} {3794594400 10800 1 EEST} {3812824800 7200 0 EET} {3826044000 10800 1 EEST} {3844274400 7200 0 EET} {3857493600 10800 1 EEST} {3875724000 7200 0 EET} {3888943200 10800 1 EEST} {3907778400 7200 0 EET} {3920392800 10800 1 EEST} {3939228000 7200 0 EET} {3951842400 10800 1 EEST} {3970677600 7200 0 EET} {3983896800 10800 1 EEST} {4002127200 7200 0 EET} {4015346400 10800 1 EEST} {4033576800 7200 0 EET} {4046796000 10800 1 EEST} {4065026400 7200 0 EET} {4078245600 10800 1 EEST} {4097080800 7200 0 EET} } |
Changes to library/tzdata/Asia/Hebron.
︙ | ︙ | |||
112 113 114 115 116 117 118 | {1445547600 7200 0 EET} {1458946800 10800 1 EEST} {1477692000 7200 0 EET} {1490396400 10800 1 EEST} {1509141600 7200 0 EET} {1521846000 10800 1 EEST} {1540591200 7200 0 EET} | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 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 192 193 194 195 196 197 198 199 200 201 202 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 | {1445547600 7200 0 EET} {1458946800 10800 1 EEST} {1477692000 7200 0 EET} {1490396400 10800 1 EEST} {1509141600 7200 0 EET} {1521846000 10800 1 EEST} {1540591200 7200 0 EET} {1553810400 10800 1 EEST} {1572040800 7200 0 EET} {1585260000 10800 1 EEST} {1604095200 7200 0 EET} {1616709600 10800 1 EEST} {1635544800 7200 0 EET} {1648159200 10800 1 EEST} {1666994400 7200 0 EET} {1680213600 10800 1 EEST} {1698444000 7200 0 EET} {1711663200 10800 1 EEST} {1729893600 7200 0 EET} {1743112800 10800 1 EEST} {1761343200 7200 0 EET} {1774562400 10800 1 EEST} {1793397600 7200 0 EET} {1806012000 10800 1 EEST} {1824847200 7200 0 EET} {1838066400 10800 1 EEST} {1856296800 7200 0 EET} {1869516000 10800 1 EEST} {1887746400 7200 0 EET} {1900965600 10800 1 EEST} {1919196000 7200 0 EET} {1932415200 10800 1 EEST} {1950645600 7200 0 EET} {1963864800 10800 1 EEST} {1982700000 7200 0 EET} {1995314400 10800 1 EEST} {2014149600 7200 0 EET} {2027368800 10800 1 EEST} {2045599200 7200 0 EET} {2058818400 10800 1 EEST} {2077048800 7200 0 EET} {2090268000 10800 1 EEST} {2108498400 7200 0 EET} {2121717600 10800 1 EEST} {2140552800 7200 0 EET} {2153167200 10800 1 EEST} {2172002400 7200 0 EET} {2184616800 10800 1 EEST} {2203452000 7200 0 EET} {2216671200 10800 1 EEST} {2234901600 7200 0 EET} {2248120800 10800 1 EEST} {2266351200 7200 0 EET} {2279570400 10800 1 EEST} {2297800800 7200 0 EET} {2311020000 10800 1 EEST} {2329855200 7200 0 EET} {2342469600 10800 1 EEST} {2361304800 7200 0 EET} {2374524000 10800 1 EEST} {2392754400 7200 0 EET} {2405973600 10800 1 EEST} {2424204000 7200 0 EET} {2437423200 10800 1 EEST} {2455653600 7200 0 EET} {2468872800 10800 1 EEST} {2487708000 7200 0 EET} {2500322400 10800 1 EEST} {2519157600 7200 0 EET} {2531772000 10800 1 EEST} {2550607200 7200 0 EET} {2563826400 10800 1 EEST} {2582056800 7200 0 EET} {2595276000 10800 1 EEST} {2613506400 7200 0 EET} {2626725600 10800 1 EEST} {2644956000 7200 0 EET} {2658175200 10800 1 EEST} {2677010400 7200 0 EET} {2689624800 10800 1 EEST} {2708460000 7200 0 EET} {2721679200 10800 1 EEST} {2739909600 7200 0 EET} {2753128800 10800 1 EEST} {2771359200 7200 0 EET} {2784578400 10800 1 EEST} {2802808800 7200 0 EET} {2816028000 10800 1 EEST} {2834258400 7200 0 EET} {2847477600 10800 1 EEST} {2866312800 7200 0 EET} {2878927200 10800 1 EEST} {2897762400 7200 0 EET} {2910981600 10800 1 EEST} {2929212000 7200 0 EET} {2942431200 10800 1 EEST} {2960661600 7200 0 EET} {2973880800 10800 1 EEST} {2992111200 7200 0 EET} {3005330400 10800 1 EEST} {3024165600 7200 0 EET} {3036780000 10800 1 EEST} {3055615200 7200 0 EET} {3068229600 10800 1 EEST} {3087064800 7200 0 EET} {3100284000 10800 1 EEST} {3118514400 7200 0 EET} {3131733600 10800 1 EEST} {3149964000 7200 0 EET} {3163183200 10800 1 EEST} {3181413600 7200 0 EET} {3194632800 10800 1 EEST} {3213468000 7200 0 EET} {3226082400 10800 1 EEST} {3244917600 7200 0 EET} {3258136800 10800 1 EEST} {3276367200 7200 0 EET} {3289586400 10800 1 EEST} {3307816800 7200 0 EET} {3321036000 10800 1 EEST} {3339266400 7200 0 EET} {3352485600 10800 1 EEST} {3371320800 7200 0 EET} {3383935200 10800 1 EEST} {3402770400 7200 0 EET} {3415384800 10800 1 EEST} {3434220000 7200 0 EET} {3447439200 10800 1 EEST} {3465669600 7200 0 EET} {3478888800 10800 1 EEST} {3497119200 7200 0 EET} {3510338400 10800 1 EEST} {3528568800 7200 0 EET} {3541788000 10800 1 EEST} {3560623200 7200 0 EET} {3573237600 10800 1 EEST} {3592072800 7200 0 EET} {3605292000 10800 1 EEST} {3623522400 7200 0 EET} {3636741600 10800 1 EEST} {3654972000 7200 0 EET} {3668191200 10800 1 EEST} {3686421600 7200 0 EET} {3699640800 10800 1 EEST} {3717871200 7200 0 EET} {3731090400 10800 1 EEST} {3749925600 7200 0 EET} {3762540000 10800 1 EEST} {3781375200 7200 0 EET} {3794594400 10800 1 EEST} {3812824800 7200 0 EET} {3826044000 10800 1 EEST} {3844274400 7200 0 EET} {3857493600 10800 1 EEST} {3875724000 7200 0 EET} {3888943200 10800 1 EEST} {3907778400 7200 0 EET} {3920392800 10800 1 EEST} {3939228000 7200 0 EET} {3951842400 10800 1 EEST} {3970677600 7200 0 EET} {3983896800 10800 1 EEST} {4002127200 7200 0 EET} {4015346400 10800 1 EEST} {4033576800 7200 0 EET} {4046796000 10800 1 EEST} {4065026400 7200 0 EET} {4078245600 10800 1 EEST} {4097080800 7200 0 EET} } |
Changes to library/tzdata/Asia/Hong_Kong.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Hong_Kong) { {-9223372036854775808 27402 0 LMT} {-2056690800 28800 0 HKT} | | | | | | | | | | | | | 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 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Hong_Kong) { {-9223372036854775808 27402 0 LMT} {-2056690800 28800 0 HKT} {-900910800 32400 1 HKST} {-891579600 30600 1 HKWT} {-884248200 32400 0 JST} {-761209200 28800 0 HKT} {-747907200 32400 1 HKST} {-728541000 28800 0 HKT} {-717049800 32400 1 HKST} {-697091400 28800 0 HKT} {-683785800 32400 1 HKST} {-668061000 28800 0 HKT} {-654755400 32400 1 HKST} {-636611400 28800 0 HKT} {-623305800 32400 1 HKST} {-605161800 28800 0 HKT} {-591856200 32400 1 HKST} {-573712200 28800 0 HKT} {-559801800 32400 1 HKST} {-541657800 28800 0 HKT} {-528352200 32400 1 HKST} {-510211800 28800 0 HKT} {-498112200 32400 1 HKST} {-478762200 28800 0 HKT} {-466662600 32400 1 HKST} {-446707800 28800 0 HKT} {-435213000 32400 1 HKST} |
︙ | ︙ |
Changes to library/tzdata/Asia/Seoul.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Seoul) { {-9223372036854775808 30472 0 LMT} {-1948782472 30600 0 KST} {-1830414600 32400 0 JST} {-767350800 32400 0 KST} {-498128400 30600 0 KST} {-462702600 34200 1 KDT} {-451733400 30600 0 KST} {-429784200 34200 1 KDT} {-418296600 30600 0 KST} {-399544200 34200 1 KDT} {-387451800 30600 0 KST} | > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Seoul) { {-9223372036854775808 30472 0 LMT} {-1948782472 30600 0 KST} {-1830414600 32400 0 JST} {-767350800 32400 0 KST} {-681210000 36000 1 KDT} {-672228000 32400 0 KST} {-654771600 36000 1 KDT} {-640864800 32400 0 KST} {-623408400 36000 1 KDT} {-609415200 32400 0 KST} {-588848400 36000 1 KDT} {-577965600 32400 0 KST} {-498128400 30600 0 KST} {-462702600 34200 1 KDT} {-451733400 30600 0 KST} {-429784200 34200 1 KDT} {-418296600 30600 0 KST} {-399544200 34200 1 KDT} {-387451800 30600 0 KST} |
︙ | ︙ |
Changes to library/tzdata/Europe/Brussels.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Europe/Brussels) { {-9223372036854775808 1050 0 LMT} {-2840141850 1050 0 BMT} | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # created by tools/tclZIC.tcl - do not edit set TZData(:Europe/Brussels) { {-9223372036854775808 1050 0 LMT} {-2840141850 1050 0 BMT} {-2450995200 0 0 WET} {-1740355200 3600 0 CET} {-1693702800 7200 0 CEST} {-1680483600 3600 0 CET} {-1663455600 7200 1 CEST} {-1650150000 3600 0 CET} {-1632006000 7200 1 CEST} {-1618700400 3600 0 CET} |
︙ | ︙ |
Changes to library/tzdata/Europe/Istanbul.
︙ | ︙ | |||
12 13 14 15 16 17 18 | {-1522551600 7200 0 EET} {-1507514400 10800 1 EEST} {-1490583600 7200 0 EET} {-1440208800 10800 1 EEST} {-1428030000 7200 0 EET} {-1409709600 10800 1 EEST} {-1396494000 7200 0 EET} | | | < < | | | < < < < < < | | | | | | | | | < < | < | | | < < < < | | | | 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 | {-1522551600 7200 0 EET} {-1507514400 10800 1 EEST} {-1490583600 7200 0 EET} {-1440208800 10800 1 EEST} {-1428030000 7200 0 EET} {-1409709600 10800 1 EEST} {-1396494000 7200 0 EET} {-931053600 10800 1 EEST} {-922676400 7200 0 EET} {-917834400 10800 1 EEST} {-892436400 7200 0 EET} {-875844000 10800 1 EEST} {-764737200 7200 0 EET} {-744343200 10800 1 EEST} {-733806000 7200 0 EET} {-716436000 10800 1 EEST} {-701924400 7200 0 EET} {-684986400 10800 1 EEST} {-670474800 7200 0 EET} {-654141600 10800 1 EEST} {-639025200 7200 0 EET} {-622087200 10800 1 EEST} {-606970800 7200 0 EET} {-590032800 10800 1 EEST} {-575521200 7200 0 EET} {-235620000 10800 1 EEST} {-194842800 7200 0 EET} {-177732000 10800 1 EEST} {-165726000 7200 0 EET} {107910000 10800 1 EEST} {121215600 7200 0 EET} {133920000 10800 1 EEST} {152665200 7200 0 EET} {164678400 10800 1 EEST} {184114800 7200 0 EET} {196214400 10800 1 EEST} {215564400 7200 0 EET} {228873600 10800 1 EEST} {245804400 7200 0 EET} {260323200 10800 1 EEST} {267919200 10800 0 +03} {277254000 10800 0 +03} {428454000 14400 1 +04} {433893600 10800 0 +03} {468111600 7200 0 EET} {482799600 10800 1 EEST} {496710000 7200 0 EET} {512521200 10800 1 EEST} {528246000 7200 0 EET} {543970800 10800 1 EEST} {559695600 7200 0 EET} {575420400 10800 1 EEST} {591145200 7200 0 EET} {606870000 10800 1 EEST} |
︙ | ︙ |
Changes to library/tzdata/Europe/Kaliningrad.
︙ | ︙ | |||
11 12 13 14 15 16 17 | {-1618700400 3600 0 CET} {-938905200 7200 1 CEST} {-857257200 3600 0 CET} {-844556400 7200 1 CEST} {-828226800 3600 0 CET} {-812502000 7200 1 CEST} {-796777200 3600 0 CET} | > | | | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | {-1618700400 3600 0 CET} {-938905200 7200 1 CEST} {-857257200 3600 0 CET} {-844556400 7200 1 CEST} {-828226800 3600 0 CET} {-812502000 7200 1 CEST} {-796777200 3600 0 CET} {-781052400 7200 1 CEST} {-780368400 7200 0 EET} {-778730400 10800 1 EEST} {-762663600 7200 0 EET} {-749095200 10800 0 MSD} {354920400 14400 1 MSD} {370728000 10800 0 MSK} {386456400 14400 1 MSD} {402264000 10800 0 MSK} {417992400 14400 1 MSD} {433800000 10800 0 MSK} {449614800 14400 1 MSD} |
︙ | ︙ |
Changes to library/tzdata/Europe/Rome.
1 2 3 4 | # created by tools/tclZIC.tcl - do not edit set TZData(:Europe/Rome) { {-9223372036854775808 2996 0 LMT} | | | 1 2 3 4 5 6 7 8 9 10 11 12 | # created by tools/tclZIC.tcl - do not edit set TZData(:Europe/Rome) { {-9223372036854775808 2996 0 LMT} {-3252098996 2996 0 RMT} {-2403565200 3600 0 CET} {-1690765200 7200 1 CEST} {-1680487200 3600 0 CET} {-1664758800 7200 1 CEST} {-1648951200 3600 0 CET} {-1635123600 7200 1 CEST} {-1616896800 3600 0 CET} |
︙ | ︙ |
Changes to library/tzdata/Europe/Vienna.
︙ | ︙ | |||
18 19 20 21 22 23 24 | {-828226800 3600 0 CET} {-812502000 7200 1 CEST} {-796777200 3600 0 CET} {-781052400 7200 1 CEST} {-780188400 3600 0 CET} {-757386000 3600 0 CET} {-748479600 7200 1 CEST} | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | {-828226800 3600 0 CET} {-812502000 7200 1 CEST} {-796777200 3600 0 CET} {-781052400 7200 1 CEST} {-780188400 3600 0 CET} {-757386000 3600 0 CET} {-748479600 7200 1 CEST} {-733273200 3600 0 CET} {-717634800 7200 1 CEST} {-701910000 3600 0 CET} {-684975600 7200 1 CEST} {-670460400 3600 0 CET} {323823600 7200 1 CEST} {338940000 3600 0 CET} {347151600 3600 0 CET} |
︙ | ︙ |
Changes to library/tzdata/Pacific/Fiji.
︙ | ︙ | |||
23 24 25 26 27 28 29 | {1452952800 43200 0 +12} {1478354400 46800 1 +12} {1484402400 43200 0 +12} {1509804000 46800 1 +12} {1515852000 43200 0 +12} {1541253600 46800 1 +12} {1547301600 43200 0 +12} | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 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 | {1452952800 43200 0 +12} {1478354400 46800 1 +12} {1484402400 43200 0 +12} {1509804000 46800 1 +12} {1515852000 43200 0 +12} {1541253600 46800 1 +12} {1547301600 43200 0 +12} {1573308000 46800 1 +12} {1578751200 43200 0 +12} {1604757600 46800 1 +12} {1610805600 43200 0 +12} {1636812000 46800 1 +12} {1642255200 43200 0 +12} {1668261600 46800 1 +12} {1673704800 43200 0 +12} {1699711200 46800 1 +12} {1705154400 43200 0 +12} {1731160800 46800 1 +12} {1736604000 43200 0 +12} {1762610400 46800 1 +12} {1768658400 43200 0 +12} {1794060000 46800 1 +12} {1800108000 43200 0 +12} {1826114400 46800 1 +12} {1831557600 43200 0 +12} {1857564000 46800 1 +12} {1863007200 43200 0 +12} {1889013600 46800 1 +12} {1894456800 43200 0 +12} {1920463200 46800 1 +12} {1925906400 43200 0 +12} {1951912800 46800 1 +12} {1957960800 43200 0 +12} {1983967200 46800 1 +12} {1989410400 43200 0 +12} {2015416800 46800 1 +12} {2020860000 43200 0 +12} {2046866400 46800 1 +12} {2052309600 43200 0 +12} {2078316000 46800 1 +12} {2083759200 43200 0 +12} {2109765600 46800 1 +12} {2115813600 43200 0 +12} {2141215200 46800 1 +12} {2147263200 43200 0 +12} {2173269600 46800 1 +12} {2178712800 43200 0 +12} {2204719200 46800 1 +12} {2210162400 43200 0 +12} {2236168800 46800 1 +12} {2241612000 43200 0 +12} {2267618400 46800 1 +12} {2273061600 43200 0 +12} {2299068000 46800 1 +12} {2305116000 43200 0 +12} {2330517600 46800 1 +12} {2336565600 43200 0 +12} {2362572000 46800 1 +12} {2368015200 43200 0 +12} {2394021600 46800 1 +12} {2399464800 43200 0 +12} {2425471200 46800 1 +12} {2430914400 43200 0 +12} {2456920800 46800 1 +12} {2462364000 43200 0 +12} {2488370400 46800 1 +12} {2494418400 43200 0 +12} {2520424800 46800 1 +12} {2525868000 43200 0 +12} {2551874400 46800 1 +12} {2557317600 43200 0 +12} {2583324000 46800 1 +12} {2588767200 43200 0 +12} {2614773600 46800 1 +12} {2620216800 43200 0 +12} {2646223200 46800 1 +12} {2652271200 43200 0 +12} {2677672800 46800 1 +12} {2683720800 43200 0 +12} {2709727200 46800 1 +12} {2715170400 43200 0 +12} {2741176800 46800 1 +12} {2746620000 43200 0 +12} {2772626400 46800 1 +12} {2778069600 43200 0 +12} {2804076000 46800 1 +12} {2809519200 43200 0 +12} {2835525600 46800 1 +12} {2841573600 43200 0 +12} {2867580000 46800 1 +12} {2873023200 43200 0 +12} {2899029600 46800 1 +12} {2904472800 43200 0 +12} {2930479200 46800 1 +12} {2935922400 43200 0 +12} {2961928800 46800 1 +12} {2967372000 43200 0 +12} {2993378400 46800 1 +12} {2999426400 43200 0 +12} {3024828000 46800 1 +12} {3030876000 43200 0 +12} {3056882400 46800 1 +12} {3062325600 43200 0 +12} {3088332000 46800 1 +12} {3093775200 43200 0 +12} {3119781600 46800 1 +12} {3125224800 43200 0 +12} {3151231200 46800 1 +12} {3156674400 43200 0 +12} {3182680800 46800 1 +12} {3188728800 43200 0 +12} {3214130400 46800 1 +12} {3220178400 43200 0 +12} {3246184800 46800 1 +12} {3251628000 43200 0 +12} {3277634400 46800 1 +12} {3283077600 43200 0 +12} {3309084000 46800 1 +12} {3314527200 43200 0 +12} {3340533600 46800 1 +12} {3345976800 43200 0 +12} {3371983200 46800 1 +12} {3378031200 43200 0 +12} {3404037600 46800 1 +12} {3409480800 43200 0 +12} {3435487200 46800 1 +12} {3440930400 43200 0 +12} {3466936800 46800 1 +12} {3472380000 43200 0 +12} {3498386400 46800 1 +12} {3503829600 43200 0 +12} {3529836000 46800 1 +12} {3535884000 43200 0 +12} {3561285600 46800 1 +12} {3567333600 43200 0 +12} {3593340000 46800 1 +12} {3598783200 43200 0 +12} {3624789600 46800 1 +12} {3630232800 43200 0 +12} {3656239200 46800 1 +12} {3661682400 43200 0 +12} {3687688800 46800 1 +12} {3693132000 43200 0 +12} {3719138400 46800 1 +12} {3725186400 43200 0 +12} {3751192800 46800 1 +12} {3756636000 43200 0 +12} {3782642400 46800 1 +12} {3788085600 43200 0 +12} {3814092000 46800 1 +12} {3819535200 43200 0 +12} {3845541600 46800 1 +12} {3850984800 43200 0 +12} {3876991200 46800 1 +12} {3883039200 43200 0 +12} {3908440800 46800 1 +12} {3914488800 43200 0 +12} {3940495200 46800 1 +12} {3945938400 43200 0 +12} {3971944800 46800 1 +12} {3977388000 43200 0 +12} {4003394400 46800 1 +12} {4008837600 43200 0 +12} {4034844000 46800 1 +12} {4040287200 43200 0 +12} {4066293600 46800 1 +12} {4072341600 43200 0 +12} {4097743200 46800 1 +12} } |
Changes to library/tzdata/Pacific/Norfolk.
1 2 3 4 5 6 7 | # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Norfolk) { {-9223372036854775808 40312 0 LMT} {-2177493112 40320 0 +1112} {-599656320 41400 0 +1130} {152029800 45000 1 +1230} | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Norfolk) { {-9223372036854775808 40312 0 LMT} {-2177493112 40320 0 +1112} {-599656320 41400 0 +1130} {152029800 45000 1 +1230} {162916200 41400 0 +1130} {1443882600 39600 0 +11} {1561899600 39600 0 +12} {1570287600 43200 1 +12} {1586012400 39600 0 +12} {1601737200 43200 1 +12} {1617462000 39600 0 +12} {1633186800 43200 1 +12} {1648911600 39600 0 +12} {1664636400 43200 1 +12} {1680361200 39600 0 +12} {1696086000 43200 1 +12} {1712415600 39600 0 +12} {1728140400 43200 1 +12} {1743865200 39600 0 +12} {1759590000 43200 1 +12} {1775314800 39600 0 +12} {1791039600 43200 1 +12} {1806764400 39600 0 +12} {1822489200 43200 1 +12} {1838214000 39600 0 +12} {1853938800 43200 1 +12} {1869663600 39600 0 +12} {1885993200 43200 1 +12} {1901718000 39600 0 +12} {1917442800 43200 1 +12} {1933167600 39600 0 +12} {1948892400 43200 1 +12} {1964617200 39600 0 +12} {1980342000 43200 1 +12} {1996066800 39600 0 +12} {2011791600 43200 1 +12} {2027516400 39600 0 +12} {2043241200 43200 1 +12} {2058966000 39600 0 +12} {2075295600 43200 1 +12} {2091020400 39600 0 +12} {2106745200 43200 1 +12} {2122470000 39600 0 +12} {2138194800 43200 1 +12} {2153919600 39600 0 +12} {2169644400 43200 1 +12} {2185369200 39600 0 +12} {2201094000 43200 1 +12} {2216818800 39600 0 +12} {2233148400 43200 1 +12} {2248873200 39600 0 +12} {2264598000 43200 1 +12} {2280322800 39600 0 +12} {2296047600 43200 1 +12} {2311772400 39600 0 +12} {2327497200 43200 1 +12} {2343222000 39600 0 +12} {2358946800 43200 1 +12} {2374671600 39600 0 +12} {2390396400 43200 1 +12} {2406121200 39600 0 +12} {2422450800 43200 1 +12} {2438175600 39600 0 +12} {2453900400 43200 1 +12} {2469625200 39600 0 +12} {2485350000 43200 1 +12} {2501074800 39600 0 +12} {2516799600 43200 1 +12} {2532524400 39600 0 +12} {2548249200 43200 1 +12} {2563974000 39600 0 +12} {2579698800 43200 1 +12} {2596028400 39600 0 +12} {2611753200 43200 1 +12} {2627478000 39600 0 +12} {2643202800 43200 1 +12} {2658927600 39600 0 +12} {2674652400 43200 1 +12} {2690377200 39600 0 +12} {2706102000 43200 1 +12} {2721826800 39600 0 +12} {2737551600 43200 1 +12} {2753276400 39600 0 +12} {2769606000 43200 1 +12} {2785330800 39600 0 +12} {2801055600 43200 1 +12} {2816780400 39600 0 +12} {2832505200 43200 1 +12} {2848230000 39600 0 +12} {2863954800 43200 1 +12} {2879679600 39600 0 +12} {2895404400 43200 1 +12} {2911129200 39600 0 +12} {2926854000 43200 1 +12} {2942578800 39600 0 +12} {2958908400 43200 1 +12} {2974633200 39600 0 +12} {2990358000 43200 1 +12} {3006082800 39600 0 +12} {3021807600 43200 1 +12} {3037532400 39600 0 +12} {3053257200 43200 1 +12} {3068982000 39600 0 +12} {3084706800 43200 1 +12} {3100431600 39600 0 +12} {3116761200 43200 1 +12} {3132486000 39600 0 +12} {3148210800 43200 1 +12} {3163935600 39600 0 +12} {3179660400 43200 1 +12} {3195385200 39600 0 +12} {3211110000 43200 1 +12} {3226834800 39600 0 +12} {3242559600 43200 1 +12} {3258284400 39600 0 +12} {3274009200 43200 1 +12} {3289734000 39600 0 +12} {3306063600 43200 1 +12} {3321788400 39600 0 +12} {3337513200 43200 1 +12} {3353238000 39600 0 +12} {3368962800 43200 1 +12} {3384687600 39600 0 +12} {3400412400 43200 1 +12} {3416137200 39600 0 +12} {3431862000 43200 1 +12} {3447586800 39600 0 +12} {3463311600 43200 1 +12} {3479641200 39600 0 +12} {3495366000 43200 1 +12} {3511090800 39600 0 +12} {3526815600 43200 1 +12} {3542540400 39600 0 +12} {3558265200 43200 1 +12} {3573990000 39600 0 +12} {3589714800 43200 1 +12} {3605439600 39600 0 +12} {3621164400 43200 1 +12} {3636889200 39600 0 +12} {3653218800 43200 1 +12} {3668943600 39600 0 +12} {3684668400 43200 1 +12} {3700393200 39600 0 +12} {3716118000 43200 1 +12} {3731842800 39600 0 +12} {3747567600 43200 1 +12} {3763292400 39600 0 +12} {3779017200 43200 1 +12} {3794742000 39600 0 +12} {3810466800 43200 1 +12} {3826191600 39600 0 +12} {3842521200 43200 1 +12} {3858246000 39600 0 +12} {3873970800 43200 1 +12} {3889695600 39600 0 +12} {3905420400 43200 1 +12} {3921145200 39600 0 +12} {3936870000 43200 1 +12} {3952594800 39600 0 +12} {3968319600 43200 1 +12} {3984044400 39600 0 +12} {4000374000 43200 1 +12} {4016098800 39600 0 +12} {4031823600 43200 1 +12} {4047548400 39600 0 +12} {4063273200 43200 1 +12} {4078998000 39600 0 +12} {4094722800 43200 1 +12} } |
Changes to macosx/tclMacOSXFCmd.c.
︙ | ︙ | |||
343 344 345 346 347 348 349 | * Construct path to resource fork. */ Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, native, -1); Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1); | | | 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 | * Construct path to resource fork. */ Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, native, -1); Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1); result = truncate(Tcl_DStringValue(&ds), 0); if (result != 0) { /* * truncate() on a valid resource fork path may fail with a * permission error in some OS releases, try truncating with * open() instead: */ |
︙ | ︙ | |||
685 686 687 688 689 690 691 | * OSType-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfOSType( | | | 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 | * OSType-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfOSType( Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const int size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); OSType osType = (OSType) objPtr->internalRep.wideValue; int written = 0; Tcl_Encoding encoding; |
︙ | ︙ |
Changes to tests-perf/clock.perf.tcl.
︙ | ︙ | |||
118 119 120 121 122 123 124 | {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en} # Format : all (in CET, locale de) {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de} } } proc test-scan {{reptime 1000}} { | | | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en} # Format : all (in CET, locale de) {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de} } } proc test-scan {{reptime 1000}} { _test_run -convert-result {clock format $_(r) -locale en} $reptime { # Scan : date (in gmt) {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} # Scan : date (system time zone, with base) {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0} # Scan : date (system time zone, without base) {clock scan "25.11.2015" -format "%d.%m.%Y"} # Scan : greedy match |
︙ | ︙ | |||
194 195 196 197 198 199 200 | break # # Scan : long format test (allock chain) # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} # # Scan : again: # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} | < > | | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 | break # # Scan : long format test (allock chain) # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} # # Scan : again: # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} } } proc test-freescan {{reptime 1000}} { _test_run -convert-result {clock format $_(r) -locale en} $reptime { # FreeScan : relative date {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} # FreeScan : relative date with relative weekday {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1} # FreeScan : relative date with ordinal month {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1} # FreeScan : relative date with ordinal month and relative weekday |
︙ | ︙ | |||
235 236 237 238 239 240 241 | {clock scan "20:18:30 -0500" -base 148863600 -gmt 1} # FreeScan : time only, zone in string (exchange zones between system / gmt) {clock scan "19:18:30 GMT" -base 148863600} # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST {clock scan "19:18:30 MST" -base 148863600 -gmt 1 clock scan "19:18:30 EST" -base 148863600 } | < > | 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 | {clock scan "20:18:30 -0500" -base 148863600 -gmt 1} # FreeScan : time only, zone in string (exchange zones between system / gmt) {clock scan "19:18:30 GMT" -base 148863600} # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST {clock scan "19:18:30 MST" -base 148863600 -gmt 1 clock scan "19:18:30 EST" -base 148863600 } } } proc test-add {{reptime 1000}} { set tests { # Add : years {clock add 1246379415 5 years -gmt 1} # Add : months |
︙ | ︙ | |||
278 279 280 281 282 283 284 | {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET} } # if does not support add of weekdays: if {[catch {clock add 0 3 weekdays -gmt 1}]} { regsub -all {\mweekdays\M} $tests "days" tests } | | | 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 | {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET} } # if does not support add of weekdays: if {[catch {clock add 0 3 weekdays -gmt 1}]} { regsub -all {\mweekdays\M} $tests "days" tests } _test_run -convert-result {clock format $_(r) -locale en} $reptime $tests } proc test-convert {{reptime 1000}} { _test_run $reptime { # Convert locale (en -> de): {clock format [clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en] -format "%a %b %d %Y" -gmt 1 -locale de} # Convert locale (de -> en): |
︙ | ︙ |
Changes to tests-perf/test-performance.tcl.
︙ | ︙ | |||
123 124 125 126 127 128 129 | lappend reptime $maxcount } } proc _test_run {args} { upvar _ _ # parse args: | | | > | | > > > | > > > > | | 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 | lappend reptime $maxcount } } proc _test_run {args} { upvar _ _ # parse args: array set _ {-no-result 0 -uplevel 0 -convert-result {}} while {[llength $args] > 2} { if {![info exists _([set o [lindex $args 0]])]} { break } if {[string is boolean -strict $_($o)]} { set _($o) [expr {! $_($o)}] set args [lrange $args 1 end] } else { if {[llength $args] <= 2} { return -code error "value expected for option $o" } set _($o) [lindex $args 1] set args [lrange $args 2 end] } } unset -nocomplain o if {[llength $args] < 2 || [llength $args] > 3} { return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?-no-result? reptime lst ?outcmd?\"" } set _(outcmd) {puts} set args [lassign $args reptime lst] if {[llength $args]} { set _(outcmd) [lindex $args 0] |
︙ | ︙ | |||
169 170 171 172 173 174 175 | if {$_(-uplevel)} { set _(c) [list uplevel 1 $_(c)] } set _(ittime) $_(reptime) # if output result (and not once): if {!$_(-no-result)} { set _(r) [if 1 $_(c)] | > | | 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | if {$_(-uplevel)} { set _(c) [list uplevel 1 $_(c)] } set _(ittime) $_(reptime) # if output result (and not once): if {!$_(-no-result)} { set _(r) [if 1 $_(c)] if {$_(-convert-result) ne ""} { set _(r) [if 1 $_(-convert-result)] } {*}$_(outcmd) $_(r) if {[llength $_(ittime)] > 1} { # decrement max-count lset _(ittime) 1 [expr {[lindex $_(ittime) 1] - 1}] } } {*}$_(outcmd) [set _(m) [timerate $_(c) {*}$_(ittime)]] lappend _(itm) $_(m) {*}$_(outcmd) "" |
︙ | ︙ |
Changes to tests/all.tcl.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # Copyright (c) 2000 by Ajuba Solutions # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest package require Tcl 8.5- | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # Copyright (c) 2000 by Ajuba Solutions # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest package require Tcl 8.5- package require tcltest 2.5 namespace import ::tcltest::* configure {*}$argv -testdir [file dirname [file dirname [file normalize [ info script]/...]]] if {[singleProcess]} { interp debug {} -frame 1 |
︙ | ︙ |
Changes to tests/async.test.
︙ | ︙ | |||
16 17 18 19 20 21 22 23 24 25 26 27 28 29 | namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testasync [llength [info commands testasync]] proc async1 {result code} { global aresult acode set aresult $result set acode $code return "new result" } | > | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testasync [llength [info commands testasync]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] proc async1 {result code} { global aresult acode set aresult $result set acode $code return "new result" } |
︙ | ︙ | |||
198 199 200 201 202 203 204 | } -result {test pattern} -cleanup { # give other threads some time to go way so that valgrind doesn't pick up # "still reachable" cases from early thread termination after 100 testasync delete $hm } test async-4.3 {async interrupting loop-less bytecode sequence} -constraints { | | | 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | } -result {test pattern} -cleanup { # give other threads some time to go way so that valgrind doesn't pick up # "still reachable" cases from early thread termination after 100 testasync delete $hm } test async-4.3 {async interrupting loop-less bytecode sequence} -constraints { testasync knownMsvcBug } -setup { set hm [testasync create async3] } -body { apply [list {handle} [concat { global aresult set aresult {Async event not delivered} testasync marklater $handle |
︙ | ︙ |
Changes to tests/chanio.test.
︙ | ︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 if "umask" cannot be run, the # tests will be skipped. | > | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 if "umask" cannot be run, the # tests will be skipped. |
︙ | ︙ | |||
1876 1877 1878 1879 1880 1881 1882 | set f [open $path(test1) w+] list [chan configure $f -eofchar] [chan configure $f -translation] } -cleanup { chan close $f } -result {{{} {}} {auto lf}} test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup { set path(stdout) [makeFile {} stdout] | | | 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 | set f [open $path(test1) w+] list [chan configure $f -eofchar] [chan configure $f -translation] } -cleanup { chan close $f } -result {{{} {}} {auto lf}} test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup { set path(stdout) [makeFile {} stdout] } -constraints {stdio openpipe knownMsvcBug} -body { set f [open $path(script) w] chan puts -nonewline $f { chan close stdout set f1 [} chan puts $f [list open $path(stdout) w]] chan puts $f { chan configure $f1 -buffersize 777 |
︙ | ︙ | |||
2020 2021 2022 2023 2024 2025 2026 | lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {0 60 72} test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup { file delete $path(test1) set l "" | | | 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 | lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {0 60 72} test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup { file delete $path(test1) set l "" } -constraints {unixOrWin} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffersize 60 -eofchar {} lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { chan puts $f hello } lappend l [file size $path(test1)] |
︙ | ︙ | |||
2786 2787 2788 2789 2790 2791 2792 | variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } | | | 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 | variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } } -constraints {socket tempNotMac fileevent knownMsvcBug} -body { proc accept {s a p} { variable x chan event $s readable [namespace code [list readit $s]] chan configure $s -blocking off set x accepted } proc readit {s} { |
︙ | ︙ | |||
2812 2813 2814 2815 2816 2817 2818 | set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]] vwait [namespace which -variable x] chan configure $cs -blocking off writelots $cs $l chan close $cs chan close $ss vwait [namespace which -variable x] | | | 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 | set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]] vwait [namespace which -variable x] chan configure $cs -blocking off writelots $cs $l chan close $cs chan close $ss vwait [namespace which -variable x] set c } -result 2000 test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} -setup { catch {interp delete x} catch {interp delete y} } -constraints {socket tempNotMac fileevent} -body { # On Mac, this test screws up sockets such that subsequent tests using # port 2828 either cause errors or panic(). |
︙ | ︙ | |||
7028 7029 7030 7031 7032 7033 7034 | set token [after 1000 { lappend ::RES {bgerror/FAIL timeout} set ::forever has-been-reached }] vwait ::forever catch {after cancel $token} # Report | | | 7029 7030 7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 | set token [after 1000 { lappend ::RES {bgerror/FAIL timeout} set ::forever has-been-reached }] vwait ::forever catch {after cancel $token} # Report set ::RES } -cleanup { chan close $f chan close $g catch {unset ::RES} catch {unset ::forever} rename ::bgerror {} removeFile foo |
︙ | ︙ | |||
7228 7229 7230 7231 7232 7233 7234 | set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] # We need to delay on some systems until the creation of the server socket # completes. set done 0 for {set i 0} {$i < 10} {incr i} { if {![catch { set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]] | | | 7229 7230 7231 7232 7233 7234 7235 7236 7237 7238 7239 7240 7241 7242 7243 | set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] # We need to delay on some systems until the creation of the server socket # completes. set done 0 for {set i 0} {$i < 10} {incr i} { if {![catch { set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]] }]} { set done 1 break } after 100 } if {$done == 0} { chan close $ss |
︙ | ︙ | |||
7300 7301 7302 7303 7304 7305 7306 | chan flush $writer } producer vwait [namespace which -variable done] chan close $writer chan close $s after cancel $after | | | 7301 7302 7303 7304 7305 7306 7307 7308 7309 7310 7311 7312 7313 7314 7315 | chan flush $writer } producer vwait [namespace which -variable done] chan close $writer chan close $s after cancel $after set counter } -cleanup { if {$accept ne {}} {chan close $accept} } -result 1 set path(fooBar) [makeFile {} fooBar] test chan-io-55.1 {ChannelEventScriptInvoker: deletion} -constraints { |
︙ | ︙ | |||
7327 7328 7329 7330 7331 7332 7333 | set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { set f [open $path(fooBar) w] chan event $f writable [namespace code [list eventScript $f]] variable x not_done vwait [namespace which -variable x] | | | 7328 7329 7330 7331 7332 7333 7334 7335 7336 7337 7338 7339 7340 7341 7342 | set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { set f [open $path(fooBar) w] chan event $f writable [namespace code [list eventScript $f]] variable x not_done vwait [namespace which -variable x] set x } -cleanup { interp bgerror {} $handler } -result {got_error} test chan-io-56.1 {ChannelTimerProc} {testchannelevent} { set f [open $path(fooBar) w] chan puts $f "this is a test" |
︙ | ︙ | |||
7372 7373 7374 7375 7376 7377 7378 | chan puts $s "12\n34567890" chan flush $s variable result [chan gets $s2] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [chan gets $s2] vwait [namespace which -variable result] | | | 7373 7374 7375 7376 7377 7378 7379 7380 7381 7382 7383 7384 7385 7386 7387 | chan puts $s "12\n34567890" chan flush $s variable result [chan gets $s2] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [chan gets $s2] vwait [namespace which -variable result] set result } -cleanup { chan close $s chan close $s2 chan close $server } -result {12 readable 34567890 timer} test chan-io-57.2 {buffered data and file events, read} -setup { variable s2 |
︙ | ︙ | |||
7397 7398 7399 7400 7401 7402 7403 | chan puts -nonewline $s "1234567890" chan flush $s variable result [chan read $s2 1] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [chan read $s2 9] vwait [namespace which -variable result] | | | | 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 | chan puts -nonewline $s "1234567890" chan flush $s variable result [chan read $s2 1] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [chan read $s2 9] vwait [namespace which -variable result] set result } -cleanup { chan close $s chan close $s2 chan close $server } -result {1 readable 234567890 timer} test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} { set out [open $path(script) w] chan puts $out { chan puts "normal message from pipe" chan puts stderr "error message from pipe" exit 1 } proc readit {pipe} { |
︙ | ︙ |
Changes to tests/cmdAH.test.
︙ | ︙ | |||
17 18 19 20 21 22 23 24 25 26 27 28 29 30 | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] global env | > > > > | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint time64bit [expr { $::tcl_platform(pointerSize) >= 8 || [llength [info command testsize]] && [testsize st_mtime] >= 8 }] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] global env |
︙ | ︙ | |||
884 885 886 887 888 889 890 | test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} { # Only on unix will setting the execute bit on a regular file cause that # file to be executable. testchmod 0o775 $gorpfile file exe $gorpfile } 1 test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body { | | | 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 | test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} { # Only on unix will setting the execute bit on a regular file cause that # file to be executable. testchmod 0o775 $gorpfile file exe $gorpfile } 1 test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body { # On windows, must be a .exe, .com, etc. set x {} set gorpexes {} foreach ext {exe com cmd bat} { lappend x [file exe nosuchfile.$ext] set gorpexe [makeFile foo gorp.$ext] lappend gorpexes $gorpexe lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]] |
︙ | ︙ | |||
1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 | } -result "could not get modification time for file \"con\"" -returnCodes error test cmdAH-24.14.1 { Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension) } -constraints {win} -body { file mtime [file join [temporaryDirectory] CON.txt] } -match regexp -result {could not (?:get modification time|read)} -returnCodes error # owned test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body { file owned a b } -result {wrong # args: should be "file owned name"} | > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > | > > > > > > > | > | 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 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 | } -result "could not get modification time for file \"con\"" -returnCodes error test cmdAH-24.14.1 { Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension) } -constraints {win} -body { file mtime [file join [temporaryDirectory] CON.txt] } -match regexp -result {could not (?:get modification time|read)} -returnCodes error # 3155760000 is 64-bit unix time, Wed Jan 01 00:00:00 GMT 2070: test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { set filename [makeFile "" foo.text] } -body { list [file atime $filename 3155760000] [file atime $filename] } -cleanup { removeFile $filename } -result {3155760000 3155760000} test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { set filename [makeFile "" foo.text] } -body { list [file mtime $filename 3155760000] [file mtime $filename] } -cleanup { file delete -force $filename } -result {3155760000 3155760000} # owned test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body { file owned a b } -result {wrong # args: should be "file owned name"} test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup { set fn $gorpfile # prefer temp file to check owner (try to avoid bug [7de2d722bd]): if { [info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] && [file dirname $fn] ne [file normalize $::env(TEMP)] } { set fn [file join $::env(TEMP)/test-owner-from-tcl.txt] set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)] } # be sure we have really owned this file before trying to check that # (avoid dependency on admin with UAC and the setting "System objects: # Default owner for objects created by members of the Administrators group"): catch { exec takeown /F [file nativename $fn] } } -body { file owned $fn } -cleanup { if {$fn ne $gorpfile} { removeFile $fn } } -result 1 test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup { # Avoid problems with AFS set tmpfile [makeFile "data" touch.me /tmp] } -body { file owned $tmpfile } -cleanup { removeFile touch.me /tmp } -result 1 test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} { file owned / } 0 test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body { if {[info exists env(SystemRoot)]} { file owned $env(SystemRoot) } else { file owned $env(windir) } } -result 0 test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body { file owned nosuchfile } -result 0 # readlink test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body { |
︙ | ︙ |
Changes to tests/cmdMZ.test.
︙ | ︙ | |||
18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | namespace eval ::tcl::test::cmdMZ { namespace import ::tcltest::cleanupTests namespace import ::tcltest::customMatch namespace import ::tcltest::makeFile namespace import ::tcltest::removeFile namespace import ::tcltest::temporaryDirectory namespace import ::tcltest::test proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 } foreach e $expected a $actual { if {![string match $e $a]} { | > > > | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | namespace eval ::tcl::test::cmdMZ { namespace import ::tcltest::cleanupTests namespace import ::tcltest::customMatch namespace import ::tcltest::makeFile namespace import ::tcltest::removeFile namespace import ::tcltest::temporaryDirectory namespace import ::tcltest::testConstraint namespace import ::tcltest::test testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 } foreach e $expected a $actual { if {![string match $e $a]} { |
︙ | ︙ | |||
223 224 225 226 227 228 229 | # The tests for Tcl_ScanObjCmd are in scan.test # Tcl_SourceObjCmd # More tests of Tcl_SourceObjCmd are in source.test test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints { | | | | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 | # The tests for Tcl_ScanObjCmd are in scan.test # Tcl_SourceObjCmd # More tests of Tcl_SourceObjCmd are in source.test test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints { unixOrWin } -returnCodes error -body { source } -match glob -result {wrong # args: should be "source*fileName"} test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints { unixOrWin } -returnCodes error -body { source a b c d e f } -match glob -result {wrong # args: should be "source*fileName"} test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body { set file [makeFile { set x 146 error "error in sourced file" |
︙ | ︙ | |||
335 336 337 338 339 340 341 | } -returnCodes error -result {expected integer but got "b"} test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} { time bogusCmd -12456 } {0 microseconds per iteration} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body { time {format 1} } -match regexp -result {^\d+ microseconds per iteration} | | > > > > > > > > > > > > > > > > > > | 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 | } -returnCodes error -result {expected integer but got "b"} test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} { time bogusCmd -12456 } {0 microseconds per iteration} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body { time {format 1} } -match regexp -result {^\d+ microseconds per iteration} test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} knownMsvcBug { expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]} } 1 test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "time {error foo}"}} test cmdMZ-5.7.1 {Tcl_TimeObjCmd: return from time} { set x 0 proc r1 {} {upvar x x; time {incr x; return "r1"; incr x} 10} list [r1] $x } {r1 1} test cmdMZ-5.8 {Tcl_TimeObjCmd: done optimization: nested call of self inside time (if compiled)} { set x [set y 0] set m1 { if {[incr x] <= 5} { # nested call should return result, so covering that: if {![string is integer -strict [eval $m1]]} {error unexpected} } # increase again (no "continue" from nested call): incr x } time {incr y; eval $m1} 5 list $y $x } {5 20} test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate} msg] $msg } {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} test cmdMZ-6.2.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b c d} msg] $msg } {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} |
︙ | ︙ | |||
370 371 372 373 374 375 376 | } {1 {missing close-brace}} test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? net-ms$} [timerate {} 0] } 1 test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 | | > > > > > | | | | > > > > > > > > > > > > | 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 | } {1 {missing close-brace}} test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? net-ms$} [timerate {} 0] } 1 test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} knownMsvcBug { set m1 [timerate {_nrt_sleep 0} 20] set m2 [timerate {_nrt_sleep 0.2} 20] list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ [expr {[lindex $m2 0] > 100}] \ [expr {[lindex $m1 2] > 1000}] \ [expr {[lindex $m2 2] < 1000}] \ [expr {[lindex $m1 4] > 50000}] \ [expr {[lindex $m2 4] < 50000}] \ [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 100}] \ [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 100}] } [lrepeat 9 1] test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { list [catch {timerate {error foo} 1} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "timerate {error foo} 1"}} test cmdMZ-6.7.1 {Tcl_TimeRateObjCmd: return from timerate} { set x 0 proc r1 {} {upvar x x; timerate {incr x; return "r1"; incr x} 1000 10} list [r1] $x } {r1 1} test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { set m1 [timerate {break}] list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 10}] } {1 1 1 1} test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} { set m1 [timerate {continue; return -code error "unexpected"} 1000 10] list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 10}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 100}] } {1 1 1 1} test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} { set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1] list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] == 1000000}] \ [expr {[lindex $m1 6] <= 0.001}] } {1 1 1 1} test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} { set m1 {set m2 ok} if 1 $m1 timerate $m1 1000 10 if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop } ok test cmdMZ-6.12 {Tcl_TimeRateObjCmd: done optimization: nested call of self inside timerate} { set x 0 set m1 { if {[incr x] <= 5} { # nested call should return result, so covering that: if {![string is integer -strict [eval $m1]]} {error unexpected} } # increase again (no "continue" from nested call): incr x } list [lindex [timerate $m1 1000 5] 2] $x } {5 20} test cmdMZ-try-1.0 { fix for issue 45b9faf103f2 [try] interaction with local variable names produces segmentation violation |
︙ | ︙ |
Changes to tests/compile.test.
︙ | ︙ | |||
461 462 463 464 465 466 467 468 469 470 471 472 473 474 | for {set i 0} {$i < 3000} {incr i} { append body " $i" } append body {]; puts OK} regsub BODY {proc crash {} {BODY}; crash} $body script list [catch {exec [interpreter] << $script} msg] $msg } {0 OK} # Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { catch {set a([error])} msg1 catch {set bubba([join $abba $jubba]) $vol} msg2 list $msg1 $msg2 } {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}} | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 | for {set i 0} {$i < 3000} {incr i} { append body " $i" } append body {]; puts OK} regsub BODY {proc crash {} {BODY}; crash} $body script list [catch {exec [interpreter] << $script} msg] $msg } {0 OK} # Tests of nested compile (body in body compilation), should not generate stack overflow # (with abnormal program termination), bug [fec0c17d39]: proc _ti_gencode {} { # creates test interpreter on demand with [gencode] generator: if {[interp exists ti]} { return } interp create ti ti eval {proc gencode {nr {cmd eval} {nl 0}} { set code "" set e ""; if {$nl} {set e "\n"} for {set i 0} {$i < $nr} {incr i} { append code "$cmd \{$e" } append code "lappend result 1$e" for {set i 0} {$i < $nr} {incr i} { append code "\}$e" } #puts [format "%% %.40s ... %d bytes" $code [string length $code]] return $code }} } test compile-13.2 {TclCompileScript: testing expected nested scripts compilation} -setup { _ti_gencode interp recursionlimit ti [expr {10000+50}] ti eval {set result {}} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), # with 2000 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) ti eval {foreach cmd {eval "if 1" try catch} { set c [gencode [expr {![::tcl::pkgconfig get debug] ? 2000 : 1000}] $cmd] if 1 $c }} ti eval {set result} } -result {1 1 1 1} test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup { _ti_gencode interp recursionlimit ti 100 ti eval {set result {}} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), # with 500 nested scripts (bodies). It must generate "too many nested compilations" # error for any variant we're testing here: ti eval {foreach cmd {eval "if 1" try catch} { set c [gencode [expr {![info exists ::tcl_platform(debug)] ? 2000 : 1000}] $cmd] lappend errors [catch $c e] $e }} #puts $errors # all of nested calls exceed the limit, so must end with "too many nested compilations" # (or evaluations, depending on compile method/instruction and "mixed" compile within # evaliation), so no one succeeds, the result must be empty: ti eval {set result} } -result {} # # clean up: if {[interp exists ti]} { interp delete ti } rename _ti_gencode {} # Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { catch {set a([error])} msg1 catch {set bubba([join $abba $jubba]) $vol} msg2 list $msg1 $msg2 } {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}} |
︙ | ︙ |
Changes to tests/execute.test.
︙ | ︙ | |||
33 34 35 36 37 38 39 40 41 42 43 44 45 46 | && [llength [info commands testdoubleobj]] && [llength [info commands teststringobj]] }] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint testexprlongobj [llength [info commands testexprlongobj]] # Tests for the omnibus TclExecuteByteCode function: # INST_DONE not tested # INST_PUSH1 not tested # INST_PUSH4 not tested # INST_POP not tested # INST_DUP not tested | > > > > > | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | && [llength [info commands testdoubleobj]] && [llength [info commands teststringobj]] }] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint testexprlongobj [llength [info commands testexprlongobj]] if {[namespace which -command testbumpinterpepoch] eq ""} { proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } } # Tests for the omnibus TclExecuteByteCode function: # INST_DONE not tested # INST_PUSH1 not tested # INST_PUSH4 not tested # INST_POP not tested # INST_DUP not tested |
︙ | ︙ | |||
929 930 931 932 933 934 935 | # Test for [Bug #1055676], correct restoration of the stack top after the # epoch is bumped and the stack is grown in a call from a nested # evaluation set arglst [string repeat "a " 1000] proc f {args} "f $arglst" proc run {} { # bump the interp's epoch | | < | < | 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 | # Test for [Bug #1055676], correct restoration of the stack top after the # epoch is bumped and the stack is grown in a call from a nested # evaluation set arglst [string repeat "a " 1000] proc f {args} "f $arglst" proc run {} { # bump the interp's epoch testbumpinterpepoch catch f msg set msg } run } -cleanup { interp recursionlimit {} $limit } -result {too many nested evaluations (infinite loop?)} test execute-8.4 {Compile epoch bump effect on stack trace} -setup { proc foo {} { error bar } proc FOO {} { catch {error bar} m o testbumpinterpepoch return -options $o $m } } -body { catch foo m o set stack1 [dict get $o -errorinfo] catch FOO m o set stack2 [string map {FOO foo} [dict get $o -errorinfo]] |
︙ | ︙ | |||
973 974 975 976 977 978 979 980 981 982 983 984 985 986 | } -cleanup { rename demo {} } -match glob -result {-code 1 -level 0 -errorstack * -errorcode NONE -errorinfo {FOO while executing "error FOO" invoked from within "catch \[list error FOO\] m o"} -errorline 2} test execute-9.1 {Interp result resetting [Bug 1522803]} { set c 0 catch { catch {set foo} expr {1/$c} } | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 | } -cleanup { rename demo {} } -match glob -result {-code 1 -level 0 -errorstack * -errorcode NONE -errorinfo {FOO while executing "error FOO" invoked from within "catch \[list error FOO\] m o"} -errorline 2} test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup { interp create slave slave eval { package require tcltest catch [list package require -exact Tcltest [info patchlevel]] ::tcltest::loadTestedCommands if {[namespace which -command testbumpinterpepoch] eq ""} { proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } } } } -body { slave eval { lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C; } slave eval { set i 0; while {[incr i] < 3} { lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C; } } slave eval { set i 0; while {[incr i] < 3} { lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; } } slave eval { catch { lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C; } } slave eval {set res} } -cleanup { interp delete slave } -result [lrepeat 4 A B] test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup { interp create slave slave eval { package require tcltest catch [list package require -exact Tcltest [info patchlevel]] ::tcltest::loadTestedCommands if {[namespace which -command testbumpinterpepoch] eq ""} { proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } } } } -body { set res {} lappend res [catch { slave eval { lappend res A; testbumpinterpepoch; lappend res B; return -code error test; lappend res C; } } e] $e lappend res [catch { slave eval { lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C; } } e] $e lappend res [catch { slave eval { lappend res A; testbumpinterpepoch; lappend res B; return -code return test; lappend res C; } } e] $e lappend res [catch { slave eval { lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; } } e] $e list $res [slave eval {set res}] } -cleanup { interp delete slave } -result [list {1 test 1 test 2 test 3 {}} [lrepeat 4 A B]] test execute-9.1 {Interp result resetting [Bug 1522803]} { set c 0 catch { catch {set foo} expr {1/$c} } |
︙ | ︙ |
Changes to tests/expr.test.
︙ | ︙ | |||
725 726 727 728 729 730 731 | # double, convert to double. test expr-18.1 {expr and conversion of operands to numbers} { set x [lindex 11 0] catch {expr int($x)} expr {$x} } 11 | | | 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 | # double, convert to double. test expr-18.1 {expr and conversion of operands to numbers} { set x [lindex 11 0] catch {expr int($x)} expr {$x} } 11 test expr-18.2 {whitespace strings should not be == 0 (buggy strtol/strtoul)} { expr {" "} } { } # Check "expr" and interpreter result object resetting before appending # an error msg during evaluation of exprs not in {}s test expr-19.1 {expr and interpreter result object resetting} { |
︙ | ︙ |
Changes to tests/fCmd.test.
︙ | ︙ | |||
272 273 274 275 276 277 278 | cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir td1 file rename ~_totally_bogus_user td1 } -result {user "_totally_bogus_user" doesn't exist} test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup { cleanup | | | 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 | cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir td1 file rename ~_totally_bogus_user td1 } -result {user "_totally_bogus_user" doesn't exist} test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup { cleanup } -constraints {notRoot unixOrWin} -returnCodes error -body { file mkdir td1 file rename / td1 } -result {error renaming "/" to "td1": file already exists} test fCmd-3.16 {FileCopyRename: break on first error} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 |
︙ | ︙ | |||
412 413 414 415 416 417 418 | file mkdir td1 set x [list [file exists tf1] [file exists tf2] [file exists td1]] file delete tf1 td1 tf2 lappend x [file exists tf1] [file exists tf2] [file exists tf3] } -cleanup {cleanup} -result {1 1 1 0 0 0} test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup { cleanup | | | 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 | file mkdir td1 set x [list [file exists tf1] [file exists tf2] [file exists td1]] file delete tf1 td1 tf2 lappend x [file exists tf1] [file exists tf2] [file exists tf3] } -cleanup {cleanup} -result {1 1 1 0 0 0} test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup { cleanup } -constraints {notRoot unixOrWin} -body { createfile tf1 createfile tf2 file mkdir td1 catch {file delete tf1 td1 $root tf2} list [file exists tf1] [file exists tf2] [file exists td1] } -cleanup {cleanup} -result {0 1 0} test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body { |
︙ | ︙ | |||
1112 1113 1114 1115 1116 1117 1118 | set a3 [catch {file copy -force tds2 tdd2}] set a4 [catch {file copy -force tds3 tdd3}] set a5 [catch {file copy -force tds4 tdd4}] list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 } -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}] test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { cleanup | | | 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 | set a3 [catch {file copy -force tds2 tdd2}] set a4 [catch {file copy -force tds3 tdd3}] set a5 [catch {file copy -force tds4 tdd4}] list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 } -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}] test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { cleanup } -constraints {notRoot unixOrWin testchmod} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] testchmod 0o555 tds2 set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg] set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg] |
︙ | ︙ |
Changes to tests/fileName.test.
︙ | ︙ | |||
1085 1086 1087 1088 1089 1090 1091 | } -result {bad argument to "-types": abcde} file rename $horribleglobname globTest file delete -force $tildeglobname set globname globTest unset horribleglobname tildeglobname | | | | | | 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 | } -result {bad argument to "-types": abcde} file rename $horribleglobname globTest file delete -force $tildeglobname set globname globTest unset horribleglobname tildeglobname test filename-12.1 {simple globbing} {unixOrWin} { glob {} } {.} test filename-12.1.1 {simple globbing} -constraints {unixOrWin} -body { glob -types f {} } -returnCodes error -result {no files matched glob pattern ""} test filename-12.1.2 {simple globbing} {unixOrWin} { glob -types d {} } {.} test filename-12.1.3 {simple globbing} {unix} { glob -types hidden {} } {.} test filename-12.1.4 {simple globbing} -constraints {win} -body { glob -types hidden {} } -returnCodes error -result {no files matched glob pattern ""} test filename-12.1.5 {simple globbing} -constraints {win} -body { glob -types hidden c:/ } -returnCodes error -result {no files matched glob pattern "c:/"} test filename-12.1.6 {simple globbing} {win} { glob c:/ } {c:/} test filename-12.3 {simple globbing} { glob -nocomplain \{a1,a2\} } {} set globPreResult globTest/ set x1 x1.c set y1 y1.c test filename-12.4 {simple globbing} {unixOrWin} { lsort [glob globTest/x1.c globTest/y1.c globTest/foo] } "$globPreResult$x1 $globPreResult$y1" test filename-12.5 {simple globbing} { glob globTest\\/x1.c } "$globPreResult$x1" test filename-12.6 {simple globbing} { glob globTest\\/\\x1.c |
︙ | ︙ | |||
1174 1175 1176 1177 1178 1179 1180 | } "$globPreResult$x1" test filename-13.9 {globbing with brace substitution} { lsort [glob globTest/\{x,y\}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.10 {globbing with brace substitution} { lsort [glob globTest/\{x,,y\}1.c] } [list $globPreResult$x1 $globPreResult$y1] | | | | | | | | | | | | | | | 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 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 | } "$globPreResult$x1" test filename-13.9 {globbing with brace substitution} { lsort [glob globTest/\{x,y\}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.10 {globbing with brace substitution} { lsort [glob globTest/\{x,,y\}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.11 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/\{x,x\\,z,z\}1.c] } [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}] test filename-13.13 {globbing with brace substitution} { lsort [glob globTest/{a,b,x,y}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.14 {globbing with brace substitution} {unixOrWin} { lsort [glob {globTest/{x1,y2,weird name}.c}] } {{globTest/weird name.c} globTest/x1.c} test filename-13.16 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{x1.c,a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} test filename-13.18 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{x1.c,{a},a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} test filename-13.20 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{a,x}1/*/{x,y}*] } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} test filename-13.22 {globbing with brace substitution} -body { glob globTest/\{a,x\}1/*/\{ } -returnCodes error -result {unmatched open-brace in file name} test filename-14.1 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob glo*/*.c] } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.3 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/?1.c] } {globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.5 {asterisks, question marks, and brackets} -setup { # The current directory could be anywhere; do this to stop spurious # matches file mkdir globTestContext file rename globTest [file join globTestContext globTest] set savepwd [pwd] cd globTestContext } -constraints {unixOrWin} -body { lsort [glob */*/*/*.c] } -cleanup { # Reset to where we were cd $savepwd file rename [file join globTestContext globTest] globTest file delete globTestContext } -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} test filename-14.7 {asterisks, question marks, and brackets} {unix} { lsort [glob globTest/*] } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.7.1 {asterisks, question marks, and brackets} {win} { lsort [glob globTest/*] } {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/.*] } {globTest/. globTest/.. globTest/.1} test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*/*] } {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3} test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob {globTest/[xyab]1.*}] } {globTest/x1.c globTest/y1.c} test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*/] } {globTest/a1/ globTest/a2/ globTest/a3/} test filename-14.17 {asterisks, question marks, and brackets} -setup { global env set temp $env(HOME) } -body { set env(HOME) [file join $env(HOME) globTest] glob ~/z* } -cleanup { set env(HOME) $temp } -result [list [file join $env(HOME) globTest z1.c]] test filename-14.18 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*.c goo/*] } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.20 {asterisks, question marks, and brackets} { glob -nocomplain goo/* } {} test filename-14.21 {asterisks, question marks, and brackets} -body { glob globTest/*/gorp |
︙ | ︙ | |||
1283 1284 1285 1286 1287 1288 1289 | [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-14.26 {type specific globbing} { glob -nocomplain -dir globTest -types {readonly} * } {} | | | | | | 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 | [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-14.26 {type specific globbing} { glob -nocomplain -dir globTest -types {readonly} * } {} test filename-14.27 {Bug 2710920} {unixOrWin} { file tail [lindex [lsort [glob globTest/*/]] 0] } a1 test filename-14.28 {Bug 2710920} {unixOrWin} { file dirname [lindex [lsort [glob globTest/*/]] 0] } globTest test filename-14.29 {Bug 2710920} {unixOrWin} { file extension [lindex [lsort [glob globTest/*/]] 0] } {} test filename-14.30 {Bug 2710920} {unixOrWin} { file rootname [lindex [lsort [glob globTest/*/]] 0] } globTest/a1/ test filename-14.31 {Bug 2918610} -setup { set d [makeDirectory foo] makeFile {} bar.soom $d } -body { |
︙ | ︙ |
Changes to tests/fileSystem.test.
︙ | ︙ | |||
30 31 32 33 34 35 36 37 38 39 40 41 42 43 | testConstraint loaddll 1 } # Test for commands defined in Tcltest executable testConstraint testfilesystem [llength [info commands ::testfilesystem]] testConstraint testsetplatform [llength [info commands ::testsetplatform]] testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]] cd [tcltest::temporaryDirectory] makeFile "test file" gorp.file makeDirectory dir.dir makeDirectory [file join dir.dir dirinside.dir] makeFile "test file in directory" [file join dir.dir inside.file] | > | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | testConstraint loaddll 1 } # Test for commands defined in Tcltest executable testConstraint testfilesystem [llength [info commands ::testfilesystem]] testConstraint testsetplatform [llength [info commands ::testsetplatform]] testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] cd [tcltest::temporaryDirectory] makeFile "test file" gorp.file makeDirectory dir.dir makeDirectory [file join dir.dir dirinside.dir] makeFile "test file in directory" [file join dir.dir inside.file] |
︙ | ︙ | |||
308 309 310 311 312 313 314 | } 1 test filesystem-1.37 {file normalisation with '/./'} -body { set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....." file norm $fname } -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} test filesystem-1.38 {file normalisation with volume relative} -setup { set dir [pwd] | | | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 | } 1 test filesystem-1.37 {file normalisation with '/./'} -body { set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....." file norm $fname } -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} test filesystem-1.38 {file normalisation with volume relative} -setup { set dir [pwd] } -constraints {win moreThanOneDrive knownMsvcBug} -body { set path "[string range [lindex $drives 0] 0 1]foo" cd [lindex $drives 1] file norm $path } -cleanup { cd $dir } -result "[lindex $drives 0]foo" test filesystem-1.39 {file normalisation with volume relative} -setup { |
︙ | ︙ |
Changes to tests/format.test.
︙ | ︙ | |||
16 17 18 19 20 21 22 23 24 25 26 27 28 29 | } # %u output depends on word length, so this test is not portable. testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] test format-1.1 {integer formatting} { format "%*d %d %d %d" 6 34 16923 -12 -1 } { 34 16923 -12 -1} test format-1.2 {integer formatting} { format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12 } { 6 34 16923 -12 -1 0xe 0xC} | > | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | } # %u output depends on word length, so this test is not portable. testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] test format-1.1 {integer formatting} { format "%*d %d %d %d" 6 34 16923 -12 -1 } { 34 16923 -12 -1} test format-1.2 {integer formatting} { format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12 } { 6 34 16923 -12 -1 0xe 0xC} |
︙ | ︙ | |||
259 260 261 262 263 264 265 | test format-6.1 {floating-point zeroes} {eformat} { format "%e %f %g" 0.0 0.0 0.0 0.0 } {0.000000e+00 0.000000 0} test format-6.2 {floating-point zeroes} {eformat} { format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0} | | | | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 | test format-6.1 {floating-point zeroes} {eformat} { format "%e %f %g" 0.0 0.0 0.0 0.0 } {0.000000e+00 0.000000 0} test format-6.2 {floating-point zeroes} {eformat} { format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0} test format-6.3 {floating-point zeroes} {eformat knownMsvcBug} { format "%#.4e %#.4f %#.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0.000} test format-6.4 {floating-point zeroes} {eformat} { format "%.0e %.0f %.0g" 0.0 0.0 0.0 0.0 } {0e+00 0 0} test format-6.5 {floating-point zeroes} {eformat knownMsvcBug} { format "%#.0e %#.0f %#.0g" 0.0 0.0 0.0 0.0 } {0.e+00 0. 0.} test format-6.6 {floating-point zeroes} { format "%3.0f %3.0f %3.0f %3.0f" 0.0 0.0 0.0 0.0 } { 0 0 0 0} test format-6.7 {floating-point zeroes} { format "%3.0f %3.0f %3.0f %3.0f" 1.0 1.1 1.01 1.001 |
︙ | ︙ |
Changes to tests/http.test.
︙ | ︙ | |||
182 183 184 185 186 187 188 | } -cleanup { http::cleanup $token } -result "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" test http-3.8 {http::geturl} -body { | | | 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | } -cleanup { http::cleanup $token } -result "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" test http-3.8 {http::geturl} -body { set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000] http::data $token } -cleanup { http::cleanup $token } -result "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>POST $tail</h2> <h2>Query</h2> |
︙ | ︙ | |||
348 349 350 351 352 353 354 | } -returnCodes error -result {Illegal characters in URL path} test http-3.24 {http::geturl parse failures} -body { http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} test http-3.25 {http::meta} -setup { unset -nocomplain m token } -body { | | | | 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 | } -returnCodes error -result {Illegal characters in URL path} test http-3.24 {http::geturl parse failures} -body { http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} test http-3.25 {http::meta} -setup { unset -nocomplain m token } -body { set token [http::geturl $url -timeout 3000] array set m [http::meta $token] lsort [array names m] } -cleanup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date} test http-3.26 {http::meta} -setup { unset -nocomplain m token } -body { set token [http::geturl $url -headers {X-Check 1} -timeout 3000] array set m [http::meta $token] lsort [array names m] } -cleanup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date X-Check} test http-3.27 {http::geturl: -headers override -type} -body { |
︙ | ︙ | |||
584 585 586 587 588 589 590 | } -cleanup { catch {http::cleanup $token} } -result {connect failed connection refused} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. | | | 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 | } -cleanup { catch {http::cleanup $token} } -result {connect failed connection refused} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. set token [http::geturl //not_a_host.tcl.tk -timeout 3000 -command \#] http::wait $token http::status $token # error codes vary among platforms. } -cleanup { catch {http::cleanup $token} } -returnCodes 1 -match glob -result "couldn't open socket*" test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup { |
︙ | ︙ |
Changes to tests/interp.test.
︙ | ︙ | |||
1832 1833 1834 1835 1836 1837 1838 | lappend l [interp aliases a] [interp hidden a] } -cleanup { interp delete a } -result {{} bar {} bar bar {} {}} test interp-23.2 {testing hiding vs aliases: safe interp} -setup { catch {interp delete a} set l "" | | | 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 | lappend l [interp aliases a] [interp hidden a] } -cleanup { interp delete a } -result {{} bar {} bar bar {} {}} test interp-23.2 {testing hiding vs aliases: safe interp} -setup { catch {interp delete a} set l "" } -constraints {unixOrWin} -body { interp create a -safe lappend l [lsort [interp hidden a]] a alias bar bar lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] a hide bar lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] a alias bar {} |
︙ | ︙ |
Changes to tests/io.test.
︙ | ︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. | > | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. |
︙ | ︙ | |||
2207 2208 2209 2210 2211 2212 2213 | lappend l [file size $path(test1)] flush $f lappend l [file size $path(test1)] close $f set l } {0 60 72} test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ | | | | 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 | lappend l [file size $path(test1)] flush $f lappend l [file size $path(test1)] close $f set l } {0 60 72} test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ {unixOrWin} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffersize 60 -eofchar {} set l "" lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { puts $f hello } lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f { |
︙ | ︙ | |||
2828 2829 2830 2831 2832 2833 2834 | # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output) # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ | | | 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 | # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output) # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f {fconfigure $f -translation lf} |
︙ | ︙ | |||
8079 8080 8081 8082 8083 8084 8085 | list [gets $c] [chan copy $c $outChan -size 100] [gets $c] } -cleanup { close $outChan close $c removeFile out } -result {line 100 line} | | | 8080 8081 8082 8083 8084 8085 8086 8087 8088 8089 8090 8091 8092 8093 8094 | list [gets $c] [chan copy $c $outChan -size 100] [gets $c] } -cleanup { close $outChan close $c removeFile out } -result {line 100 line} test io-54.1 {Recursive channel events} {socket fileevent knownMsvcBug} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. proc accept {s a p} { variable as fconfigure $s -translation lf puts $s "line 1\nline2\nline3" |
︙ | ︙ | |||
8288 8289 8290 8291 8292 8293 8294 | vwait [namespace which -variable result] close $s close $s2 close $server set result } {1 readable 234567890 timer} | | | 8289 8290 8291 8292 8293 8294 8295 8296 8297 8298 8299 8300 8301 8302 8303 | vwait [namespace which -variable result] close $s close $s2 close $server set result } {1 readable 234567890 timer} test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} { set out [open $path(script) w] puts $out { puts "normal message from pipe" puts stderr "error message from pipe" exit 1 } proc readit {pipe} { |
︙ | ︙ |
Changes to tests/ioCmd.test.
︙ | ︙ | |||
21 22 23 24 25 26 27 28 29 30 31 32 33 34 | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] package require tcltests # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] #---------------------------------------------------------------------- test iocmd-1.1 {puts command} { list [catch {puts} msg] $msg } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} test iocmd-1.2 {puts command} { | > | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] package require tcltests # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] #---------------------------------------------------------------------- test iocmd-1.1 {puts command} { list [catch {puts} msg] $msg } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} test iocmd-1.2 {puts command} { |
︙ | ︙ | |||
290 291 292 293 294 295 296 | } -returnCodes error -cleanup { catch {close $chan} } -result [expectedOpts "-buffer" {}] removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 | | | 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 | } -returnCodes error -cleanup { catch {close $chan} } -result [expectedOpts "-buffer" {}] removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} set cli [socket 127.0.0.1 $port] } -body { fconfigure $cli -blah } -cleanup { |
︙ | ︙ | |||
398 399 400 401 402 403 404 | test iocmd-10.5 {fblocked command} { fblocked stdin } 0 set path(test4) [makeFile {} test4] set path(test5) [makeFile {} test5] | | | | | | 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 | test iocmd-10.5 {fblocked command} { fblocked stdin } 0 set path(test4) [makeFile {} test4] set path(test5) [makeFile {} test5] test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} { set f [open $path(test4) w] close $f list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode } {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrWin} { list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode } {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}} test iocmd-12.1 {POSIX open access modes: RDONLY} { file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" |
︙ | ︙ | |||
806 807 808 809 810 811 812 | lappend res [file channel rc*] lappend res [catch {chan create {r w} foo} msg] lappend res $msg lappend res [file channel rc*] rename foo {} set res } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}} | | | 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 | lappend res [file channel rc*] lappend res [catch {chan create {r w} foo} msg] lappend res $msg lappend res [file channel rc*] rename foo {} set res } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}} test iocmd-21.20 {Bug 88aef05cda} -constraints knownMsvcBug -setup { proc foo {method chan args} { switch -- $method blocking { chan configure $chan -blocking [lindex $args 0] return } initialize { return {initialize finalize watch blocking read write configure cget cgetall} |
︙ | ︙ | |||
2011 2012 2013 2014 2015 2016 2017 | } -result {{unmatched open brace in list}} test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] set tock {} note [fileevent $c readable {lappend res TOCK; set tock 1}] | | | | 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 | } -result {{unmatched open brace in list}} test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] set tock {} note [fileevent $c readable {lappend res TOCK; set tock 1}] set stop [after 15000 {lappend res TIMEOUT; set tock 1}] after 1000 {note [chan postevent $c r]} vwait ::tock catch {after cancel $stop} close $c rename foo {} set res } -result {{watch rc* read} {} {} TOCK {watch rc* {}}} test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] note [fileevent $c writable {lappend res TOCK; set tock 1}] set stop [after 15000 {lappend res TIMEOUT; set tock 1}] after 1000 {note [chan postevent $c w]} vwait ::tock catch {after cancel $stop} close $c rename foo {} set res } -result {{watch rc* write} {} {} TOCK {watch rc* {}}} |
︙ | ︙ |
Changes to tests/pid.test.
︙ | ︙ | |||
17 18 19 20 21 22 23 | } testConstraint pidDefined [llength [info commands pid]] test pid-1.1 {pid command} pidDefined { regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid] } 1 | | | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | } testConstraint pidDefined [llength [info commands pid]] test pid-1.1 {pid command} pidDefined { regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid] } 1 test pid-1.2 {pid command} -constraints {unixOrWin unixExecs pidDefined} -setup { set path(test1) [makeFile {} test1] file delete $path(test1) } -body { set f [open |[list echo foo | cat >$path(test1)] w] set pids [pid $f] close $f list [llength $pids] [regexp {^[0-9]+$} [lindex $pids 0]] \ |
︙ | ︙ |
Changes to tests/socket.test.
︙ | ︙ | |||
71 72 73 74 75 76 77 78 79 80 81 82 83 84 | if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} { return } # Some tests require the Thread package or exec command testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] testConstraint exec [llength [info commands exec]] # Produce a random port number in the Dynamic/Private range # from 49152 through 65535. proc randport {} { # firstly try dynamic port via server-socket(0): set port 0x7fffffff catch { | > | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} { return } # Some tests require the Thread package or exec command testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] testConstraint exec [llength [info commands exec]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # Produce a random port number in the Dynamic/Private range # from 49152 through 65535. proc randport {} { # firstly try dynamic port via server-socket(0): set port 0x7fffffff catch { |
︙ | ︙ | |||
1079 1080 1081 1082 1083 1084 1085 | after cancel $timer close $s close $s1 } -result {1 3} test socket_$af-7.5 {testing socket specific options} -setup { set timer [after 10000 "set x timed_out"] set l "" | | | 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 | after cancel $timer close $s close $s1 } -result {1 3} test socket_$af-7.5 {testing socket specific options} -setup { set timer [after 10000 "set x timed_out"] set l "" } -constraints [list socket supported_$af unixOrWin] -body { set s [socket -server accept 0] proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s } set listen [lindex [fconfigure $s -sockname] 2] |
︙ | ︙ | |||
2281 2282 2283 2284 2285 2286 2287 | list [fconfigure $sock -error] [gets $fd] } -cleanup { close $fd close $sock removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ | | | 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 | list [fconfigure $sock -error] [gets $fd] } -cleanup { close $fd close $sock removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ -constraints {socket knownMsvcBug} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 puts $sock ok fileevent $sock writable {set x 1} vwait x close $sock |
︙ | ︙ |
Changes to tests/stringObj.test.
︙ | ︙ | |||
435 436 437 438 439 440 441 | } 1 test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo | | | | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 | } 1 test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo teststringobj maxchars 1 teststringobj append 1 bar -1 teststringobj maxchars 1 teststringobj append 1 bar -1 teststringobj setlength 1 0 teststringobj append 1 bar -1 teststringobj get 1 } {bar} test stringObj-15.1 {Tcl_Append*ToObj: self appends} testobj { |
︙ | ︙ |
Changes to tests/tcltest.test.
︙ | ︙ | |||
94 95 96 97 98 99 100 | removeFile error if {[string length $err]} { set code 1 append msg \n$err } return $code } | | | | | | | | | | | 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | removeFile error if {[string length $err]} { set code 1 append msg \n$err } return $code } test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} { set result [slave msg test.tcl] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} test tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} { set result [slave msg test.tcl -verbose 'b'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} test tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} { set result [slave msg test.tcl -verbose 'p'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 1 0 1} test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} { set result [slave msg test.tcl -verbose 's'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 0 1 1} test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} { set result [slave msg test.tcl -verbose 'ps'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 1 1 1} test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} { set result [slave msg test.tcl -verbose 'psb'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 1 1} test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} { set result [slave msg test.tcl -verbose "pass skip body"] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 1 1} test tcltest-2.6 {tcltest -verbose 't'} { -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose 't'] list $result $msg } -result {^0 .*a-1.0 start.*b-1.0 start} -match regexp } test tcltest-2.6a {tcltest -verbose 'start'} { -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose start] list $result $msg } -result {^0 .*a-1.0 start.*b-1.0 start} -match regexp } |
︙ | ︙ | |||
172 173 174 175 176 177 178 | verbose $oldVerbosity list $currentVerbosity $newVerbosity } -result {body {}} } test tcltest-2.8 {tcltest -verbose 'error'} { | | | | | | | | | | | | | | 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 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 | verbose $oldVerbosity list $currentVerbosity $newVerbosity } -result {body {}} } test tcltest-2.8 {tcltest -verbose 'error'} { -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose error] list $result $msg } -result {errorInfo: foo.*errorCode: 9} -match regexp } # -match, [match] test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} { set result [slave msg test.tcl -match a* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 1 0 0 1} test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} { set result [slave msg test.tcl -match b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg] } {0 0 1 0 1} test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} { set result [slave msg test.tcl -match c* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg] } {0 0 0 1 1} test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} { set result [slave msg test.tcl -match {a* b*} -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg] } {0 1 1 0 1} test tcltest-3.5 {tcltest::match} { -body { set oldMatch [match] match foo set currentMatch [match] match bar set newMatch [match] match $oldMatch list $currentMatch $newMatch } -result {foo bar} } # -skip, [skip] test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} { set result [slave msg test.tcl -skip a* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg] } {0 0 1 1 1} test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} { set result [slave msg test.tcl -skip b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg] } {0 1 0 1 1} test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} { set result [slave msg test.tcl -skip c* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 0 1} test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} { set result [slave msg test.tcl -skip {a* b*} -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg] } {0 0 0 1 1} test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} { set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 1 0 0 1} test tcltest-4.6 {tcltest::skip} { -body { set oldSkip [skip] skip foo set currentSkip [skip] skip bar set newSkip [skip] skip $oldSkip list $currentSkip $newSkip } -result {foo bar} } # -constraints, -limitconstraints, [testConstraint], # $constraintsSpecified, [limitConstraints] test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} { set result [slave msg test.tcl -constraints knownBug -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg] } {0 1 1 1 1} test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} { set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 0 0 1 1} test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)} { -body { |
︙ | ︙ | |||
351 352 353 354 355 356 357 | ::tcltest::PrintError "a really really long string containing a \ \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\"" exit } printerror.tcl] test tcltest-6.1 {tcltest -outfile, -errfile defaults} { | | | | | | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 | ::tcltest::PrintError "a really really long string containing a \ \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\"" exit } printerror.tcl] test tcltest-6.1 {tcltest -outfile, -errfile defaults} { -constraints unixOrWin -body { slave msg $printerror return $msg } -result {a test.*a really} -match regexp } test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} { slave msg $printerror -outfile a.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {0 1 0 1 1 {}} test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} { slave msg $printerror -errfile a.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {1 0 1 0 1 {}} test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} { slave msg $printerror -outfile a.tmp -errfile b.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" b.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 \ [file exists a.tmp] [file delete a.tmp] \ [file exists b.tmp] [file delete b.tmp] |
︙ | ︙ | |||
460 461 462 463 464 465 466 | } } # -debug, [debug] # Must use child processes to test -debug because it always writes # messages to stdout, and we have no way to capture stdout of a # slave interp | | | | | | | 460 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 488 489 490 491 492 | } } # -debug, [debug] # Must use child processes to test -debug because it always writes # messages to stdout, and we have no way to capture stdout of a # slave interp test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 0} msg regexp "Flags passed into tcltest" $msg } {0} test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg list [regexp userSpecifiedSkip $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 1 -match b*} msg list [regexp userSpecifiedNonMatch $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 2} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 0} test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 3} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 1} test tcltest-7.6 {tcltest::debug} { -setup { set old $::tcltest::debug |
︙ | ︙ | |||
518 519 520 521 522 523 524 | set tdiaf [makeFile {} thisdirectoryisafile] set normaldirectory [makeDirectory normaldirectory] normalizePath normaldirectory # -tmpdir, [temporaryDirectory] | | | | 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 | set tdiaf [makeFile {} thisdirectoryisafile] set normaldirectory [makeDirectory normaldirectory] normalizePath normaldirectory # -tmpdir, [temporaryDirectory] test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup { file delete -force thisdirectorydoesnotexist } -body { slave msg $a -tmpdir thisdirectorydoesnotexist file exists [file join thisdirectorydoesnotexist a.tmp] } -cleanup { file delete -force thisdirectorydoesnotexist } -result 1 test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} { -constraints unixOrWin -body { slave msg $a -tmpdir $tdiaf return $msg } -result {*not a directory*} -match glob } |
︙ | ︙ | |||
568 569 570 571 572 573 574 | # interfere with tcltest-5.5 testConstraint notFAT [expr { ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]] || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]] }] # FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} { | | | | 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 | # interfere with tcltest-5.5 testConstraint notFAT [expr { ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]] || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]] }] # FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} { -constraints {unixOrWin notRoot notFAT} -body { slave msg $a -tmpdir $notWriteableDir return $msg } -result {*not writeable*} -match glob } test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} { -constraints unixOrWin -body { slave msg $a -tmpdir $normaldirectory # The join is necessary because the message can be split on multiple # lines file exists [file join $normaldirectory a.tmp] } -cleanup { |
︙ | ︙ | |||
620 621 622 623 624 625 626 | list $f1 $f2 $f3 } -cleanup { set ::tcltest::temporaryDirectory $old } -result [list $normaldirectory [workingDirectory] [workingDirectory]] cd [temporaryDirectory] # -testdir, [testsDirectory] test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} { | | | | | 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 659 660 661 662 663 664 | list $f1 $f2 $f3 } -cleanup { set ::tcltest::temporaryDirectory $old } -result [list $normaldirectory [workingDirectory] [workingDirectory]] cd [temporaryDirectory] # -testdir, [testsDirectory] test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} { -constraints unixOrWin -setup { file delete -force thisdirectorydoesnotexist } -body { slave msg $a -testdir thisdirectorydoesnotexist return $msg } -match glob -result {*does not exist*} } test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} { -constraints unixOrWin -body { slave msg $a -testdir $tdiaf return $msg } -match glob -result {*not a directory*} } test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} { -constraints {unix notRoot} -body { slave msg $a -testdir $notReadableDir return $msg } -match glob -result {*not readable*} } test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} { -constraints unixOrWin -body { slave msg $a -testdir $normaldirectory # The join is necessary because the message can be split on multiple # lines list [string first "testdir: $normaldirectory" [join $msg]] \ [file exists [file join [temporaryDirectory] a.tmp]] } |
︙ | ︙ | |||
727 728 729 730 731 732 733 | file delete -force -- $notReadableDir $notWriteableDir removeFile a.tcl removeFile thisdirectoryisafile removeDirectory normaldirectory # -file, -notfile, [matchFiles], [skipFiles] | | | | 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 | file delete -force -- $notReadableDir $notWriteableDir removeFile a.tcl removeFile thisdirectoryisafile removeDirectory normaldirectory # -file, -notfile, [matchFiles], [skipFiles] test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { slave msg [file join [testsDirectory] all.tcl] -file d*.test return $msg } -cleanup { testsDirectory $old } -match regexp -result {dstring\.test} test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { slave msg [file join [testsDirectory] all.tcl] \ -file d*.test -notfile dstring* regexp {dstring\.test} $msg } -cleanup { |
︙ | ︙ | |||
802 803 804 805 806 807 808 | close $f } {} ::tcltest::cleanupTests return } makecore.tcl] cd [temporaryDirectory] | | | | | | 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 | close $f } {} ::tcltest::cleanupTests return } makecore.tcl] cd [temporaryDirectory] test tcltest-10.1 {-preservecore 0} {unixOrWin} { slave msg $mc -preservecore 0 file delete core regexp "Core file produced" $msg } {0} test tcltest-10.2 {-preservecore 1} {unixOrWin} { slave msg $mc -preservecore 1 file delete core regexp "Core file produced" $msg } {1} test tcltest-10.3 {-preservecore 2} {unixOrWin} { slave msg $mc -preservecore 2 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} test tcltest-10.4 {-preservecore 3} {unixOrWin} { slave msg $mc -preservecore 3 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} # Removing this test. It makes no sense to test the ability of |
︙ | ︙ | |||
849 850 851 852 853 854 855 | package require tcltest namespace import tcltest::* puts [outputChannel] $::tcltest::loadScript exit } set loadfile [makeFile $contents load.tcl] | | | | 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 | package require tcltest namespace import tcltest::* puts [outputChannel] $::tcltest::loadScript exit } set loadfile [makeFile $contents load.tcl] test tcltest-12.1 {-load xxx} {unixOrWin} { slave msg $loadfile -load xxx return $msg } {xxx} # Using child process because of -debug usage. test tcltest-12.2 {-loadfile load.tcl} {unixOrWin} { catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg list \ [regexp {tcltest} [join [list $msg] [split $msg \n]]] \ [regexp {loadScript} [join [list $msg] [split $msg \n]]] } {1 1} test tcltest-12.3 {loadScript} { |
︙ | ︙ | |||
946 947 948 949 950 951 952 | namespace import tcltest::* testsDirectory [file join [temporaryDirectory] singleprocdir] runAllTests } all-single.tcl $spd] cd [workingDirectory] test tcltest-14.1 {-singleproc - single process} { | | | | 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 | namespace import tcltest::* testsDirectory [file join [temporaryDirectory] singleprocdir] runAllTests } all-single.tcl $spd] cd [workingDirectory] test tcltest-14.1 {-singleproc - single process} { -constraints {unixOrWin} -body { slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory] return $msg } -result {Test file error: can't unset .foo.: no such variable} -match regexp } test tcltest-14.2 {-singleproc - multiple process} { -constraints {unixOrWin} -body { slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory] return $msg } -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0} -match regexp } |
︙ | ︙ | |||
1020 1021 1022 1023 1024 1025 1026 | package require tcltest namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3] runAllTests } all.tcl $dtd3 test tcltest-15.1 {basic directory walking} { | | | | | | | 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 | package require tcltest namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3] runAllTests } all.tcl $dtd3 test tcltest-15.1 {basic directory walking} { -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -match regexp -returnCodes 1 -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123]} } test tcltest-15.2 {-asidefromdir} { -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -asidefromdir dirtestdir2.3 \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -match regexp -returnCodes 1 -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[12].*Tests located in:.*dirtestdir2.[12].*dirtestdir2.[12] test ended at .*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Error: No test files remain after applying your match and skip patterns! Error: No test files remain after applying your match and skip patterns! Error: No test files remain after applying your match and skip patterns!$} } test tcltest-15.3 {-relateddir, non-existent dir} { -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -relateddir [file join [temporaryDirectory] dirtestdir0] \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -returnCodes 1 -match regexp -result {[^~]|dirtestdir[^2]} } test tcltest-15.4 {-relateddir, subdir} { -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} { error $msg } } -returnCodes 1 -match regexp -result {Tests located in:.*dirtestdir2.[^23]} } test tcltest-15.5 {-relateddir, -asidefromdir} { -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -relateddir "dirtestdir2.1 dirtestdir2.2" \ -asidefromdir dirtestdir2.2 \ -tmpdir [temporaryDirectory]] == 1} { error $msg |
︙ | ︙ | |||
1169 1170 1171 1172 1173 1174 1175 | } -result {^3$} -match regexp -output\ {tcltest::debug\s+= 2.*tcltest::debug\s+= 3} # Begin testing of tcltest procs ... cd [temporaryDirectory] # PrintError | | | 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 | } -result {^3$} -match regexp -output\ {tcltest::debug\s+= 2.*tcltest::debug\s+= 3} # Begin testing of tcltest procs ... cd [temporaryDirectory] # PrintError test tcltest-20.1 {PrintError} {unixOrWin} { set result [slave msg $printerror] list $result [regexp "Error: a really short string" $msg] \ [regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \ [regexp " \"Really" $msg] [regexp Problem $msg] } {1 1 1 1 1 1} cd [workingDirectory] removeFile printerror.tcl |
︙ | ︙ | |||
1405 1406 1407 1408 1409 1410 1411 | } cleanupTests } test.test $atd # Must use a child process because stdout/stderr parsing can't be # duplicated in slave interp. test tcltest-22.1 {runAllTests} { | | | 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 | } cleanupTests } test.test $atd # Must use a child process because stdout/stderr parsing can't be # duplicated in slave interp. test tcltest-22.1 {runAllTests} { -constraints {unixOrWin} -body { exec [interpreter] \ [file join $atd all.tcl] \ -verbose t -tmpdir [temporaryDirectory] } -match regexp -result "Test files exiting with errors:.*error.test.*exit.test" |
︙ | ︙ |
Changes to tests/tm.test.
︙ | ︙ | |||
196 197 198 199 200 201 202 | ::tcl::tm::path list } -result {geode snarf foo} proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] | | | 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | ::tcl::tm::path list } -result {geode snarf foo} proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor set results {} set base [file join $base tcl$major] lappend results [file join $base site-tcl] for {set i 0} {$i <= $minor} {incr i} { lappend results [file join $base ${major}.$i] } return $results |
︙ | ︙ |
Changes to tests/uplevel.test.
︙ | ︙ | |||
79 80 81 82 83 84 85 86 87 88 89 90 91 92 | } 66 test uplevel-3.4 {uplevel to same level} { set y zzz proc a1 {} {set y 55; uplevel #1 set y} a1 } 55 test uplevel-4.1 {error: non-existent level} -returnCodes error -body { apply {{} { uplevel #2 {set y 222} }} } -result {bad level "#2"} test uplevel-4.2 {error: non-existent level} -returnCodes error -body { apply {{} { | > > > > > > > > > > | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | } 66 test uplevel-3.4 {uplevel to same level} { set y zzz proc a1 {} {set y 55; uplevel #1 set y} a1 } 55 test uplevel-4.0.1 {error: non-existent level} -body { uplevel #0 { uplevel { set y 222 } } } -returnCodes error -result {bad level "1"} test uplevel-4.0.2 {error: non-existent level} -setup { interp create i } -body { i eval { uplevel { set y 222 } } } -returnCodes error -result {bad level "1"} -cleanup { interp delete i } test uplevel-4.1 {error: non-existent level} -returnCodes error -body { apply {{} { uplevel #2 {set y 222} }} } -result {bad level "#2"} test uplevel-4.2 {error: non-existent level} -returnCodes error -body { apply {{} { |
︙ | ︙ |
Changes to tests/upvar.test.
︙ | ︙ | |||
300 301 302 303 304 305 306 307 308 309 310 311 312 313 | test upvar-8.2.1 {upvar with numeric first argument} { apply {{} {set 0 ok; apply {{} {upvar 0 x; return $x}}}} } ok test upvar-8.3 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar a b c} p1 } -result {bad level "a"} test upvar-8.4 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar 0 b b} p1 } -result {can't upvar from variable to itself} test upvar-8.5 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar 0 a b; upvar 0 b a} p1 | > > > > > > > > > > > | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 | test upvar-8.2.1 {upvar with numeric first argument} { apply {{} {set 0 ok; apply {{} {upvar 0 x; return $x}}}} } ok test upvar-8.3 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar a b c} p1 } -result {bad level "a"} test upvar-8.3.1 {bad level for upvar (upvar at top-level, bug [775ee88560])} -body { proc p1 {} { uplevel { upvar b b; lappend b UNEXPECTED } } uplevel #0 { p1 } } -returnCodes error -result {bad level "1"} test upvar-8.3.2 {bad level for upvar (upvar at top-level, bug [775ee88560])} -setup { interp create i } -body { i eval { upvar b b; lappend b UNEXPECTED } } -returnCodes error -result {bad level "1"} -cleanup { interp delete i } test upvar-8.4 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar 0 b b} p1 } -result {can't upvar from variable to itself} test upvar-8.5 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar 0 a b; upvar 0 b a} p1 |
︙ | ︙ | |||
351 352 353 354 355 356 357 | } -body { array set upvarArray {} upvar 0 upvarArray(elem) upvarArrayElemAlias(elem) } -returnCodes 1 -match glob -result * test upvar-9.1 {Tcl_UpVar2 procedure} testupvar { list [catch {testupvar xyz a {} x global} msg] $msg | | | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 | } -body { array set upvarArray {} upvar 0 upvarArray(elem) upvarArrayElemAlias(elem) } -returnCodes 1 -match glob -result * test upvar-9.1 {Tcl_UpVar2 procedure} testupvar { list [catch {testupvar xyz a {} x global} msg] $msg } {1 {bad level "1"}} test upvar-9.1.1 {TclGetFrame, via Tcl_UpVar2} testupvar { apply {{} {testupvar xyz a {} x local; set x foo}} set a } foo test upvar-9.2 {Tcl_UpVar2 procedure} testupvar { catch {unset a} catch {unset x} |
︙ | ︙ |
Changes to tests/utf.test.
︙ | ︙ | |||
467 468 469 470 471 472 473 | test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 a teststringobj set 2 b | | | | | | | | | | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 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 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 | test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 a teststringobj set 2 b teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result -1 test utf-25.2 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 b teststringobj set 2 a teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 test utf-25.3 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 B teststringobj set 2 a teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 test utf-25.4 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 aBcB teststringobj set 2 abca teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 |
︙ | ︙ |
Changes to tests/winFCmd.test.
︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 | testConstraint winXP 0 testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint testfile [llength [info commands testfile]] testConstraint testchmod [llength [info commands testchmod]] testConstraint cdrom 0 testConstraint exdev 0 testConstraint longFileNames 0 proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string close $f return $string } | > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | testConstraint winXP 0 testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint testfile [llength [info commands testfile]] testConstraint testchmod [llength [info commands testchmod]] testConstraint cdrom 0 testConstraint exdev 0 testConstraint longFileNames 0 testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string close $f return $string } |
︙ | ︙ | |||
88 89 90 91 92 93 94 | } } } # NB: filename is chosen to be short but unlikely to clash with other apps if {[file exists c:/] && [file exists d:/]} { catch {file delete d:/TclTmpF.1} | > > | > > > | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | } } } # NB: filename is chosen to be short but unlikely to clash with other apps if {[file exists c:/] && [file exists d:/]} { catch {file delete d:/TclTmpF.1} catch {file delete d:/TclTmpD.1} catch {file delete c:/TclTmpC.1} if {![catch {createfile d:/TclTmpF.1 {}}] && [file isfile d:/TclTmpF.1] && ![catch {file mkdir d:/TclTmpD.1}] && [file isdirectory d:/TclTmpD.1] && ![catch {file mkdir c:/TclTmpC.1}] && [file isdirectory c:/TclTmpC.1] } { file delete d:/TclTmpF.1 d:/TclTmpD.1 c:/TclTmpC.1 testConstraint exdev 1 } } file delete -force -- td1 if {![catch {open td1 w} testfile]} { close $testfile |
︙ | ︙ | |||
169 170 171 172 173 174 175 | cleanup } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv td1 tf1 } -returnCodes error -result ENOTDIR test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} -setup { | | | | | | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 | cleanup } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv td1 tf1 } -returnCodes error -result ENOTDIR test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} -setup { file delete -force d:/TclTmpD.1 } -constraints {win exdev testfile} -body { file mkdir c:/TclTmpC.1 testfile mv c:/TclTmpC.1 d:/TclTmpD.1 } -cleanup { file delete -force c:/TclTmpC.1 } -returnCodes error -result EXDEV test winFCmd-1.11 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win testfile} -body { set fd [open tf1 w] testfile mv tf1 tf2 } -cleanup { |
︙ | ︙ | |||
312 313 314 315 316 317 318 | file mkdir td1/td2 file mkdir td2 testfile mv td1 td2 list [file exists td1] [file exists td2] [file exists td2/td2] } -result {0 1 1} test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \ -constraints {win exdev testfile testchmod} -body { | | | | | | | | | | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 | file mkdir td1/td2 file mkdir td2 testfile mv td1 td2 list [file exists td1] [file exists td2] [file exists td2/td2] } -result {0 1 1} test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \ -constraints {win exdev testfile testchmod} -body { file mkdir d:/TclTmpD.1 testchmod 0 d:/TclTmpD.1 file mkdir c:/TclTmpC.1 catch {testfile mv c:/TclTmpC.1 d:/TclTmpD.1} msg list $msg [file writable d:/TclTmpD.1] } -cleanup { catch {testchmod 0o666 d:/TclTmpD.1} file delete d:/TclTmpD.1 file delete -force c:/TclTmpC.1 } -result {EXDEV 0} test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv td1 tf1 |
︙ | ︙ | |||
384 385 386 387 388 389 390 | lappend inodes $stat(ino) unset stat } } test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup { cleanup | | | 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | lappend inodes $stat(ino) unset stat } } test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup { cleanup } -constraints {win winNonZeroInodes knownMsvcBug} -body { file mkdir td1 foreach {a b} [MakeFiles td1] break file rename -force $a $b file exists $a } -cleanup { cleanup } -result {0} |
︙ | ︙ | |||
629 630 631 632 633 634 635 | list [file type td1] [file type td2] } -cleanup { cleanup } -result {directory directory} test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup | | | 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 | list [file type td1] [file type td2] } -cleanup { cleanup } -result {directory directory} test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup } -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { catch {testchmod 0o666 td1} cleanup |
︙ | ︙ | |||
683 684 685 686 687 688 689 | cleanup } -constraints {win testfile} -body { createfile tf1 list [catch {testfile rmdir tf1} msg] [file tail $msg] } -result {1 {tf1 ENOTDIR}} test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup { cleanup | | | | 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 | cleanup } -constraints {win testfile} -body { createfile tf1 list [catch {testfile rmdir tf1} msg] [file tail $msg] } -result {1 {tf1 ENOTDIR}} test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup { cleanup } -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { catch {testchmod 0o666 td1} cleanup } -result {td1 EACCES} test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup { cleanup } -constraints {win testfile} -body { testfile rmdir / # WinXP returns EEXIST, WinNT seems to return EACCES. No policy # decision has been made as to which is correct. } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup { cleanup } -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -cleanup { catch {testchmod 0o666 td1} cleanup |
︙ | ︙ | |||
930 931 932 933 934 935 936 | } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 testfile rmdir -force td1 } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup | | | 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 | } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 testfile rmdir -force td1 } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup } -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1/td2 testchmod 0 td1 testfile rmdir -force td1 file exists td1 } -cleanup { catch {testchmod 0o666 td1} cleanup |
︙ | ︙ | |||
1044 1045 1046 1047 1048 1049 1050 | } -cleanup { cleanup } -result {./td1} test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body { list [file attributes / -longname] [file attributes \\ -longname] } -constraints {win} -result {/ /} test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup { | | | | | | | 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 | } -cleanup { cleanup } -result {./td1} test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body { list [file attributes / -longname] [file attributes \\ -longname] } -constraints {win} -result {/ /} test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup { catch {file delete -force -- c:/TclTmpC.1} } -constraints {win winXP} -body { createfile c:/TclTmpC.1 {} string tolower [file attributes c:/TclTmpC.1 -longname] } -cleanup { file delete -force -- c:/TclTmpC.1 } -result [string tolower {c:/TclTmpC.1}] test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup { catch {file delete -force -- $::env(TEMP)/td1} } -constraints {win} -body { createfile $::env(TEMP)/td1 {} string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \ [string tolower [file normalize $::env(TEMP)]/td1] } -cleanup { |
︙ | ︙ |
Changes to tests/winTime.test.
︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 24 25 26 27 28 | namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testwinclock [llength [info commands testwinclock]] # The next two tests will crash on Windows if the check for negative # clock values is not done properly. test winTime-1.1 {TclpGetDate} {win} { set ::env(TZ) JST-9 set result [clock format -1 -format %Y] | > | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testwinclock [llength [info commands testwinclock]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # The next two tests will crash on Windows if the check for negative # clock values is not done properly. test winTime-1.1 {TclpGetDate} {win} { set ::env(TZ) JST-9 set result [clock format -1 -format %Y] |
︙ | ︙ | |||
36 37 38 39 40 41 42 | set result } {1969} # Next test tries to make sure that the Tcl clock stays in step # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? | | | | 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 | set result } {1969} # Next test tries to make sure that the Tcl clock stays in step # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock knownMsvcBug} { # May fail due to OS/hardware discrepancies. See: # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 set failed {} set ok 1 foreach start_sec [testwinclock] break while { 1 } { foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break set diff [expr { $tcl_sec - $sys_sec + 1.0e-6 * ( $tcl_usec - $sys_usec ) }] if { abs($diff) > 0.1 } { set failed "Tcl clock differs from system clock by $diff sec" break } else { testwinsleep 1 } if { $sys_sec - $start_sec >= 30 } break } set failed } {} # cleanup ::tcltest::cleanupTests return |
Changes to tests/zipfs.test.
︙ | ︙ | |||
41 42 43 44 45 46 47 | ### # "make test" does not map tcl_library from the dynamic library on Unix # # Hack the environment to pretend we did pull tcl_library from a zip # archive ### set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]] | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | ### # "make test" does not map tcl_library from the dynamic library on Unix # # Hack the environment to pretend we did pull tcl_library from a zip # archive ### set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]] testConstraint zipfslib [file isfile $tclzip] if {[testConstraint zipfslib]} { zipfs mount /lib/tcl $tclzip set ::tcl_library ${ziproot}lib/tcl/tcl_library } } test zipfs-0.2 {zipfs basics} -constraints zipfslib -body { |
︙ | ︙ |
Changes to tools/tcltk-man2html-utils.tcl.
︙ | ︙ | |||
872 873 874 875 876 877 878 | url - end-bold { append result \ [string range $text 0 [expr {$offset(bold)-1}]] set body [string range $text [expr {$offset(bold)+3}] \ [expr {$offset(end-bold)-1}]] set text [string range $text[set text ""] \ [expr {$offset(end-bold)+4}] end] | | | 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 | url - end-bold { append result \ [string range $text 0 [expr {$offset(bold)-1}]] set body [string range $text [expr {$offset(bold)+3}] \ [expr {$offset(end-bold)-1}]] set text [string range $text[set text ""] \ [expr {$offset(end-bold)+4}] end] regsub {http://[\w/.-]+} $body {<A HREF="&">&</A>} body append result <B> [cross-reference $body] </B> continue } anchor { append result \ [string range $text 0 [expr {$offset(end-bold)+3}]] set text [string range $text[set text ""] \ |
︙ | ︙ | |||
908 909 910 911 912 913 914 | set text [string range $text[set text ""] [expr {$off+3}] end] append result [cross-reference Tcl] continue } url { set off [lindex $offsets 0] append result [string range $text 0 [expr {$off-1}]] | | | 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 | set text [string range $text[set text ""] [expr {$off+3}] end] append result [cross-reference Tcl] continue } url { set off [lindex $offsets 0] append result [string range $text 0 [expr {$off-1}]] regexp -indices -start $off {http://[\w/.-]+} $text range set url [string range $text {*}$range] append result "<A HREF=\"[string trimright $url .]\">$url</A>" set text [string range $text[set text ""] \ [expr {[lindex $range 1]+1}] end] continue } end-anchor - end-bold - end-quote { |
︙ | ︙ |
Changes to unix/Makefile.in.
︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 | prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS # with replication. It allows the pathnames used for installation to be # different than those used for actually reference files at run-time. # INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. INSTALL_ROOT = $(DESTDIR) | > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS # with replication. It allows the pathnames used for installation to be # different than those used for actually reference files at run-time. # INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. INSTALL_ROOT = $(DESTDIR) |
︙ | ︙ | |||
944 945 946 947 948 949 950 | $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done @echo "Installing package msgcat 1.7.0 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)"/tcl8/8.7/msgcat-1.7.0.tm @echo "Installing package tcltest 2.5.0 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ | | | 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 | $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done @echo "Installing package msgcat 1.7.0 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)"/tcl8/8.7/msgcat-1.7.0.tm @echo "Installing package tcltest 2.5.0 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ "$(MODULE_INSTALL_DIR)"/tcl8/8.5/tcltest-2.5.1.tm @echo "Installing package platform 1.0.14 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ "$(MODULE_INSTALL_DIR)"/tcl8/8.4/platform-1.0.14.tm @echo "Installing package platform::shell 1.1.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \ "$(MODULE_INSTALL_DIR)"/tcl8/8.4/platform/shell-1.1.4.tm @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/" |
︙ | ︙ |
Changes to unix/configure.
︙ | ︙ | |||
3329 3330 3331 3332 3333 3334 3335 | ;; esac #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: | | | | 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 | ;; esac #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol or strtoul in some versions # of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- ac_ext=c ac_cpp='$CPP $CPPFLAGS' |
︙ | ︙ | |||
3816 3817 3818 3819 3820 3821 3822 | /* end confdefs.h. */ #include <stdlib.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtoul" >/dev/null 2>&1; then : | < < < < < < < < < < < < < | 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 | /* end confdefs.h. */ #include <stdlib.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtoul" >/dev/null 2>&1; then : else tcl_ok=0 fi rm -f conftest* if test $tcl_ok = 0; then |
︙ | ︙ | |||
5656 5657 5658 5659 5660 5661 5662 | do64bit_ok=yes fi fi # The combo of gcc + glibc has a bug related to inlining of | | | 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 | do64bit_ok=yes fi fi # The combo of gcc + glibc has a bug related to inlining of # functions like strtol()/strtoul(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. if test x"${USE_COMPAT}" != x; then : CFLAGS="$CFLAGS -fno-inline" fi |
︙ | ︙ | |||
9832 9833 9834 9835 9836 9837 9838 | fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 $as_echo "$tcl_ok" >&6; } #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can | | | 9819 9820 9821 9822 9823 9824 9825 9826 9827 9828 9829 9830 9831 9832 9833 | fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 $as_echo "$tcl_ok" >&6; } #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can # be overridden on the configure command line either way. #------------------------------------------------------------------------ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5 $as_echo_n "checking for timezone data... " >&6; } # Check whether --with-tzdata was given. if test "${with_tzdata+set}" = set; then : |
︙ | ︙ |
Changes to unix/configure.ac.
︙ | ︙ | |||
85 86 87 88 89 90 91 | AC_PROG_CC AC_C_INLINE #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: | | | | 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | AC_PROG_CC AC_C_INLINE #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol or strtoul in some versions # of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- SC_MISSING_POSIX_HEADERS |
︙ | ︙ | |||
673 674 675 676 677 678 679 | AC_DEFINE(TCL_UNLOAD_DLLS, 1, [Do we allow unloading of shared libraries?]) fi AC_MSG_RESULT([$tcl_ok]) #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can | | | 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 | AC_DEFINE(TCL_UNLOAD_DLLS, 1, [Do we allow unloading of shared libraries?]) fi AC_MSG_RESULT([$tcl_ok]) #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can # be overridden on the configure command line either way. #------------------------------------------------------------------------ AC_MSG_CHECKING([for timezone data]) AC_ARG_WITH(tzdata, AC_HELP_STRING([--with-tzdata], [install timezone data (default: autodetect)]), [tcl_ok=$withval], [tcl_ok=auto]) |
︙ | ︙ |
Changes to unix/tcl.m4.
︙ | ︙ | |||
1307 1308 1309 1310 1311 1312 1313 | AS_IF([test $tcl_cv_cc_m64 = yes], [ CFLAGS="$CFLAGS -m64" do64bit_ok=yes ]) ]) # The combo of gcc + glibc has a bug related to inlining of | | | 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 | AS_IF([test $tcl_cv_cc_m64 = yes], [ CFLAGS="$CFLAGS -m64" do64bit_ok=yes ]) ]) # The combo of gcc + glibc has a bug related to inlining of # functions like strtol()/strtoul(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) ;; Lynx*) |
︙ | ︙ | |||
1909 1910 1911 1912 1913 1914 1915 | ]) #-------------------------------------------------------------------- # SC_MISSING_POSIX_HEADERS # # Supply substitutes for missing POSIX header files. Special # notes: | | | | 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 | ]) #-------------------------------------------------------------------- # SC_MISSING_POSIX_HEADERS # # Supply substitutes for missing POSIX header files. Special # notes: # - stdlib.h doesn't define strtol or strtoul in some # versions of SunOS # - some versions of string.h don't declare procedures such # as strstr # # Arguments: # none # # Results: |
︙ | ︙ | |||
1961 1962 1963 1964 1965 1966 1967 | if test $tcl_cv_dirent_h = no; then AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?]) fi AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) | < | 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 | if test $tcl_cv_dirent_h = no; then AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?]) fi AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) if test $tcl_ok = 0; then AC_DEFINE(NO_STDLIB_H, 1, [Do we have <stdlib.h>?]) fi AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0) AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0) |
︙ | ︙ |
Changes to unix/tclLoadAix.c.
︙ | ︙ | |||
94 95 96 97 98 99 100 | static void *findMain(void); void * dlopen( const char *path, int mode) { | | | 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 | static void *findMain(void); void * dlopen( const char *path, int mode) { ModulePtr mp; static void *mainModule; /* * Upon the first call register a terminate handler that will close all * libraries. Also get a reference to the main module for use with * loadbind. */ |
︙ | ︙ | |||
187 188 189 190 191 192 193 | /* * If the user wants global binding, loadbind against all other loaded * modules. */ if (mode & RTLD_GLOBAL) { | | | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | /* * If the user wants global binding, loadbind against all other loaded * modules. */ if (mode & RTLD_GLOBAL) { ModulePtr mp1; for (mp1 = mp->next; mp1; mp1 = mp1->next) { if (loadbind(0, mp1->entry, mp->entry) == -1) { goto loadbindFailure; } } } |
︙ | ︙ | |||
239 240 241 242 243 244 245 | * error message buffer. */ static void caterr( char *s) { | | | 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 | * error message buffer. */ static void caterr( char *s) { char *p = s; while (*p >= '0' && *p <= '9') { p++; } switch (atoi(s)) { /* INTL: "C", UTF safe. */ case L_ERROR_TOOMANY: strcat(errbuf, "to many errors"); |
︙ | ︙ | |||
278 279 280 281 282 283 284 | } void * dlsym( void *handle, const char *symbol) { | | | | | 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 | } void * dlsym( void *handle, const char *symbol) { ModulePtr mp = (ModulePtr)handle; ExportPtr ep; int i; /* * Could speed up the search, but I assume that one assigns the result to * function pointers anyways. */ for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { |
︙ | ︙ | |||
313 314 315 316 317 318 319 | return NULL; } int dlclose( void *handle) { | | | | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 | return NULL; } int dlclose( void *handle) { ModulePtr mp = (ModulePtr)handle; int result; ModulePtr mp1; if (--mp->refCnt > 0) { return 0; } if (mp->info && mp->info->fini) { mp->info->fini(); |
︙ | ︙ | |||
339 340 341 342 343 344 345 | result = unload(mp->entry); if (result == -1) { errvalid++; strcpy(errbuf, strerror(errno)); } if (mp->exports) { | | | | 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 | result = unload(mp->entry); if (result == -1) { errvalid++; strcpy(errbuf, strerror(errno)); } if (mp->exports) { ExportPtr ep; int i; for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { if (ep->name) { free(ep->name); } } free(mp->exports); } |
︙ | ︙ |
Changes to unix/tclUnixChan.c.
︙ | ︙ | |||
92 93 94 95 96 97 98 | #endif /* SUPPORTS_TTY */ } TtyState; #ifdef SUPPORTS_TTY /* * The following structure is used to set or get the serial port attributes in | | | 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | #endif /* SUPPORTS_TTY */ } TtyState; #ifdef SUPPORTS_TTY /* * The following structure is used to set or get the serial port attributes in * a platform-independent manner. */ typedef struct { int baud; int parity; int data; int stop; |
︙ | ︙ |
Changes to unix/tclUnixCompat.c.
︙ | ︙ | |||
681 682 683 684 685 686 687 | static int CopyGrp( struct group *tgtPtr, char *buf, int buflen) { | | | | 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 | static int CopyGrp( struct group *tgtPtr, char *buf, int buflen) { char *p = buf; int copied, len = 0; /* * Copy username. */ copied = CopyString(tgtPtr->gr_name, p, buflen - len); if (copied == -1) { |
︙ | ︙ | |||
883 884 885 886 887 888 889 | int elsize, /* Size of each element, or -1 to indicate * that they are C strings of dynamic * length. */ char *buf, /* Buffer to copy into. */ int buflen) /* Size of buffer. */ { int i, j, len = 0; | | | | | | 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 | int elsize, /* Size of each element, or -1 to indicate * that they are C strings of dynamic * length. */ char *buf, /* Buffer to copy into. */ int buflen) /* Size of buffer. */ { int i, j, len = 0; char *p, **newBuffer; if (src == NULL) { return 0; } for (i = 0; src[i] != NULL; i++) { /* * Empty loop to count how many. */ } len = sizeof(char *) * (i + 1); /* Leave place for the array. */ if (len > buflen) { return -1; } newBuffer = (char **) buf; p = buf + len; for (j = 0; j < i; j++) { int sz = (elsize<0 ? (int) strlen(src[j]) + 1 : elsize); len += sz; if (len > buflen) { return -1; } memcpy(p, src[j], sz); newBuffer[j] = p; p = buf + len; } newBuffer[j] = NULL; return len; } #endif /* NEED_COPYARRAY */ /* *--------------------------------------------------------------------------- |
︙ | ︙ |
Changes to unix/tclUnixFCmd.c.
︙ | ︙ | |||
1311 1312 1313 1314 1315 1316 1317 | if (chmod(dst, newMode)) { /* INTL: Native. */ newMode &= ~(S_ISUID | S_ISGID); if (chmod(dst, newMode)) { /* INTL: Native. */ return TCL_ERROR; } } | | | | 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 | if (chmod(dst, newMode)) { /* INTL: Native. */ newMode &= ~(S_ISUID | S_ISGID); if (chmod(dst, newMode)) { /* INTL: Native. */ return TCL_ERROR; } } tval.actime = Tcl_GetAccessTimeFromStat(statBufPtr); tval.modtime = Tcl_GetModificationTimeFromStat(statBufPtr); if (utime(dst, &tval)) { /* INTL: Native. */ return TCL_ERROR; } #ifdef MAC_OSX_TCL TclMacOSXCopyFileAttributes(src, dst, statBufPtr); #endif |
︙ | ︙ |
Changes to unix/tclUnixInit.c.
1 2 3 4 5 6 7 8 9 10 11 | /* * tclUnixInit.c -- * * Contains the Unix-specific interpreter initialization functions. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. */ #include "tclInt.h" | < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclUnixInit.c -- * * Contains the Unix-specific interpreter initialization functions. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. */ #include "tclInt.h" #ifdef HAVE_LANGINFO # include <langinfo.h> # ifdef __APPLE__ # if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* Support for weakly importing nl_langinfo on Darwin. */ # define WEAK_IMPORT_NL_LANGINFO extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE; |
︙ | ︙ | |||
331 332 333 334 335 336 337 | /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * | | | 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 | /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * * Initialize all the platform-dependent things like signals and * floating-point error handling. * * Called at process initialization time. * * Results: * None. * |
︙ | ︙ | |||
407 408 409 410 411 412 413 | */ setlocale(LC_CTYPE, ""); /* * In case the initial locale is not "C", ensure that the numeric * processing is done in "C" locale regardless. This is needed because Tcl | | | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 | */ setlocale(LC_CTYPE, ""); /* * In case the initial locale is not "C", ensure that the numeric * processing is done in "C" locale regardless. This is needed because Tcl * relies on routines like strtol/strtoul, but should not have locale dependent * behavior. */ setlocale(LC_NUMERIC, "C"); #ifdef GET_DARWIN_RELEASE { |
︙ | ︙ | |||
997 998 999 1000 1001 1002 1003 | * (native). */ int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { int i, result = -1; | | | 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 | * (native). */ int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { int i, result = -1; const char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); p2 = name; |
︙ | ︙ |
Changes to unix/tclUnixThrd.c.
︙ | ︙ | |||
840 841 842 843 844 845 846 | PMutex plock; } AllocMutex; Tcl_Mutex * TclpNewAllocMutex(void) { AllocMutex *lockPtr; | | | 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 | PMutex plock; } AllocMutex; Tcl_Mutex * TclpNewAllocMutex(void) { AllocMutex *lockPtr; PMutex *plockPtr; lockPtr = malloc(sizeof(AllocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } plockPtr = &lockPtr->plock; lockPtr->tlock = (Tcl_Mutex) plockPtr; |
︙ | ︙ |
Changes to unix/tclUnixTime.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclUnixTime.c -- * * Contains Unix specific versions of Tcl functions that obtain time * values from the operating system. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclUnixTime.c -- * * Contains Unix specific versions of Tcl functions that obtain time * values from the operating system. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL) #include <mach/mach_time.h> #endif /* * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread * safety, this structure must be in thread-specific data. The 'tmKey' |
︙ | ︙ | |||
114 115 116 117 118 119 120 | *---------------------------------------------------------------------- * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no garantees on what the * resolution will be. In Tcl we will call this value a "click". The | | | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | *---------------------------------------------------------------------- * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no garantees on what the * resolution will be. In Tcl we will call this value a "click". The * start time is also system dependent. * * Results: * Number of clicks from some start time. * * Side effects: * None. * |
︙ | ︙ | |||
163 164 165 166 167 168 169 | *---------------------------------------------------------------------- * * TclpGetWideClicks -- * * This procedure returns a WideInt value that represents the highest * resolution clock available on the system. There are no garantees on * what the resolution will be. In Tcl we will call this value a "click". | | | 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 | *---------------------------------------------------------------------- * * TclpGetWideClicks -- * * This procedure returns a WideInt value that represents the highest * resolution clock available on the system. There are no garantees on * what the resolution will be. In Tcl we will call this value a "click". * The start time is also system dependent. * * Results: * Number of WideInt clicks from some start time. * * Side effects: * None. * |
︙ | ︙ |
Changes to win/Makefile.in.
︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 | prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS # with replication. It allows the pathnames used for installation to be # different than those used for actually reference files at run-time. # INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. INSTALL_ROOT = | > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS # with replication. It allows the pathnames used for installation to be # different than those used for actually reference files at run-time. # INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. INSTALL_ROOT = |
︙ | ︙ | |||
92 93 94 95 96 97 98 | # following lines. COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. | | | | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | # following lines. COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. TOP_DIR = $(shell cd @srcdir@/..; pwd -W 2>/dev/null || pwd -P) GENERIC_DIR = $(TOP_DIR)/generic TOMMATH_DIR = $(TOP_DIR)/libtommath WIN_DIR = $(TOP_DIR)/win COMPAT_DIR = $(TOP_DIR)/compat PKGS_DIR = $(TOP_DIR)/pkgs ZLIB_DIR = $(COMPAT_DIR)/zlib # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ libdir_native = $(shell $(CYGPATH) '$(libdir)') bindir_native = $(shell $(CYGPATH) '$(bindir)') includedir_native = $(shell $(CYGPATH) '$(includedir)') mandir_native = $(shell $(CYGPATH) '$(mandir)') TCL_LIBRARY_NATIVE = $(shell $(CYGPATH) '$(TCL_LIBRARY)') GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)') TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W 2>/dev/null || pwd -P) ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)') #GENERIC_DIR_NATIVE = $(GENERIC_DIR) #TOMMATH_DIR_NATIVE = $(TOMMATH_DIR) #WIN_DIR_NATIVE = $(WIN_DIR) #ROOT_DIR_NATIVE = $(ROOT_DIR) # Fully qualify library path so that `make test` |
︙ | ︙ | |||
482 483 484 485 486 487 488 | # Test-suite helper (can be used to test Tcl from build directory with all expected modules). # To start from windows shell use: # > tcltest.cmd -verbose bps -file fileName.test # or from mingw/msys shell: # $ ./tcltest -verbose bps -file fileName.test | | | | | | | > > | | 483 484 485 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 511 512 513 514 515 516 517 518 519 520 | # Test-suite helper (can be used to test Tcl from build directory with all expected modules). # To start from windows shell use: # > tcltest.cmd -verbose bps -file fileName.test # or from mingw/msys shell: # $ ./tcltest -verbose bps -file fileName.test tcltest.cmd: Makefile @echo 'Create tcltest.cmd helpers'; @(\ echo '@echo off'; \ echo 'rem set LANG=en_US'; \ echo 'set BDP=%~dp0'; \ echo 'set OWD=%CD%'; \ echo 'cd /d %TEMP%'; \ echo 'rem "%BDP%\$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_FACILITIES)" %*'; \ echo '"%BDP%\$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_PRMS)" %*'; \ echo 'cd /d %OWD%'; \ ) > tcltest.cmd; @(\ echo '#!/bin/sh'; \ echo '#LANG=en_US'; \ echo 'BDP=$$(dirname $$(readlink -f %0))'; \ echo 'cd /tmp'; \ echo '#"$$BDP/$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_FACILITIES)" "$$@"'; \ echo '"$$BDP/$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_PRMS)" "$$@"'; \ ) > tcltest.sh; tcltest.sh: tcltest.cmd tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH) winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} libraries: |
︙ | ︙ | |||
544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 | $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null && \ echo "${TCL_ZIP_FILE} successful created with $$zip" && \ cd ..) $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) # The following targets are configured by autoconf to generate either a shared # library or static library ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE} @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) @VC_MANIFEST_EMBED_DLL@ @if test "${ZIPFS_BUILD}" = "1" ; then \ cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}; \ ${NATIVE_ZIP} -A ${TCL_DLL_FILE} \ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ fi ${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ ${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) ${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT} @$(RM) ${TEST_EXE_FILE} $(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) # use pre-built zlib1.dll ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \ $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ else \ $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ | > > > > > > | 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 | $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null && \ echo "${TCL_ZIP_FILE} successful created with $$zip" && \ cd ..) $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) $(COPY) tclsh.exe.manifest $(TCLSH).manifest @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) # The following targets are configured by autoconf to generate either a shared # library or static library ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE} @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${TCL_DLL_FILE}.manifest @VC_MANIFEST_EMBED_DLL@ @if test "${ZIPFS_BUILD}" = "1" ; then \ cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}; \ ${NATIVE_ZIP} -A ${TCL_DLL_FILE} \ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ fi ${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ ${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest ${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT} @$(RM) ${TEST_EXE_FILE} $(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) $(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest # use pre-built zlib1.dll ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \ $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ else \ $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ |
︙ | ︙ | |||
616 617 618 619 620 621 622 623 624 625 626 627 628 629 | tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) testMain.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) # TIP #430, ZipFS Support | > > > > > > | 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 | tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinReg.${OBJEXT}: tclWinReg.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinDde.${OBJEXT}: tclWinDde.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) testMain.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) # TIP #430, ZipFS Support |
︙ | ︙ | |||
643 644 645 646 647 648 649 | # and where it will look for its libraries (which can be different). We derive # this information from the variables which can be overridden by the user. As # every path can be configured separately we do not remember one general # prefix/exec_prefix but all the different paths individually. tclPkgConfig.${OBJEXT}: tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ | | | | | | | | | | | | 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 | # and where it will look for its libraries (which can be different). We derive # this information from the variables which can be overridden by the user. As # every path can be configured separately we do not remember one general # prefix/exec_prefix but all the different paths individually. tclPkgConfig.${OBJEXT}: tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR_NATIVE)\"" \ -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR_NATIVE)\"" \ -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR_NATIVE)\"" \ -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR_NATIVE)\"" \ -DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \ \ -DCFG_RUNTIME_LIBDIR="\"$(libdir_native)\"" \ -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \ -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \ -DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ -DBUILD_tcl \ @DEPARG@ $(CC_OBJNAME) # The following objects are part of the stub library and should not be built # as DLL objects but none of the symbols should be exported |
︙ | ︙ | |||
700 701 702 703 704 705 706 | crc32.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c deflate.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c ioapi.$(HOST_OBJEXT): | | | 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 | crc32.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c deflate.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c ioapi.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c iowin32.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c infback.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c |
︙ | ︙ | |||
730 731 732 733 734 735 736 | zip.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c zutil.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c minizip.$(HOST_OBJEXT): | | | 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 | zip.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c zutil.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c minizip.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) $(HOST_CC) -o $@ $(MINIZIP_OBJS) # The following target generates the file generic/tclDate.c from the yacc # grammar found in generic/tclGetDate.y. This is only run by hand as yacc is # not available in all environments. The name of the .c file is different than |
︙ | ︙ | |||
856 857 858 859 860 861 862 | @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.7/msgcat-1.7.0.tm; @echo "Installing package tcltest 2.4.0 as a Tcl Module"; | | | 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 | @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.7/msgcat-1.7.0.tm; @echo "Installing package tcltest 2.4.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.1.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ |
︙ | ︙ | |||
923 924 925 926 927 928 929 | # Specifying TESTFLAGS on the command line is the standard way to pass args to # tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: test-tcl test-packages | | | | | 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 | # Specifying TESTFLAGS on the command line is the standard way to pass args to # tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: test-tcl test-packages test-tcl: tcltest TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ $(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ -load "$(TEST_LOAD_FACILITIES)" # Useful target to launch a built tclsh with the proper path,... runtest: tcltest @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ $(WINE) ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` shell: binaries @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ |
︙ | ︙ | |||
955 956 957 958 959 960 961 | ./config.status cleanhelp: $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out | | | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | ./config.status cleanhelp: $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest.sh $(RM) *.pch *.ilk *.pdb $(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT} $(RM) *.zip $(RMDIR) *.vfs distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ |
︙ | ︙ |
Changes to win/cat.c.
︙ | ︙ | |||
24 25 26 27 28 29 30 | _tmain(void) { char buf[1024]; int n; const char *err; while (1) { | | | | | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | _tmain(void) { char buf[1024]; int n; const char *err; while (1) { n = _read(0, buf, sizeof(buf)); if (n <= 0) { break; } _write(1, buf, n); } err = (sizeof(int) == 2) ? "stderr16" : "stderr32"; _write(2, err, (unsigned int)strlen(err)); return 0; } |
Changes to win/configure.
︙ | ︙ | |||
774 775 776 777 778 779 780 781 782 783 784 785 786 787 | SHELL OBJEXT_FOR_BUILD' ac_subst_files='' ac_user_opts=' enable_option_checking with_encoding enable_shared enable_64bit enable_zipfs enable_symbols enable_embedded_manifest ' ac_precious_vars='build_alias host_alias | > | 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 | SHELL OBJEXT_FOR_BUILD' ac_subst_files='' ac_user_opts=' enable_option_checking with_encoding enable_shared enable_time64bit enable_64bit enable_zipfs enable_symbols enable_embedded_manifest ' ac_precious_vars='build_alias host_alias |
︙ | ︙ | |||
1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 | cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) --enable-zipfs build with Zipfs support (default: on) --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) Optional Packages: | > | 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 | cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-shared build and link with shared libraries (default: on) --enable-time64bit force 64-bit time_t for 32-bit build (default: off) --enable-64bit enable 64bit support (where applicable) --enable-zipfs build with Zipfs support (default: on) --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) Optional Packages: |
︙ | ︙ | |||
3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 | SHARED_BUILD=0 $as_echo "#define STATIC_BUILD 1" >>confdefs.h fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- | > > > > > > > > > > > > > > > > > > > | 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 | SHARED_BUILD=0 $as_echo "#define STATIC_BUILD 1" >>confdefs.h fi #-------------------------------------------------------------------- # Check whether --enable-time64bit was given. #-------------------------------------------------------------------- { $as_echo "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5 $as_echo_n "checking force of 64-bit time_t... " >&6; } # Check whether --enable-time64bit was given. if test "${enable_time64bit+set}" = set; then : enableval=$enable_time64bit; tcl_ok=$enableval else tcl_ok=no fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5 $as_echo "\"$tcl_ok\"" >&6; } if test "$tcl_ok" = "yes"; then CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- |
︙ | ︙ |
Changes to win/configure.ac.
︙ | ︙ | |||
86 87 88 89 90 91 92 93 94 95 96 97 98 99 | #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- SC_ENABLE_SHARED #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- | > > > > > > > > > > > > > > | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- SC_ENABLE_SHARED #-------------------------------------------------------------------- # Check whether --enable-time64bit was given. #-------------------------------------------------------------------- AC_MSG_CHECKING([force of 64-bit time_t]) AC_ARG_ENABLE(time64bit, AC_HELP_STRING([--enable-time64bit], [force 64-bit time_t for 32-bit build (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) AC_MSG_RESULT("$tcl_ok") if test "$tcl_ok" = "yes"; then CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- |
︙ | ︙ |
Changes to win/makefile.vc.
︙ | ︙ | |||
47 48 49 50 51 52 53 54 55 56 57 58 59 60 | # Visual Studio/Windows SDK for the appropriate target architecture. # # NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform # SDK (not expressly needed), run setenv.bat after # vcvars32.bat according to the instructions for it. This can also # turn on the 64-bit compiler, if your SDK has it. # # Examples: # c:\tcl_src\win\>nmake -f makefile.vc release # c:\tcl_src\win\>nmake -f makefile.vc test # c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl # c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs # c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols # | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | # Visual Studio/Windows SDK for the appropriate target architecture. # # NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform # SDK (not expressly needed), run setenv.bat after # vcvars32.bat according to the instructions for it. This can also # turn on the 64-bit compiler, if your SDK has it. # # Basic macros and options usable on the commandline (see rules.vc for more info): # OPTS=msvcrt,static,staticpkg,symbols,profile,unchecked,time64bit,utfmax,none # Sets special options for the core. The default is for none. # Any combination of the above may be used (comma separated). # 'none' will over-ride everything to nothing. # # msvcrt = Affects the static option only to switch it from # using libcmt(d) as the C runtime [by default] to # msvcrt(d). This is useful for static embedding # support. # static = Builds a static library of the core instead of a # dll. The shell will be static (and large), as well. # staticpkg= Affects the static option only to switch # tclshXX.exe to have the dde and reg extension linked # inside it. # thrdalloc = Use the thread allocator (shared global free pool). # symbols = Adds symbols for step debugging. # profile = Adds profiling hooks. Map file is assumed. # unchecked = Allows a symbols build to not use the debug # enabled runtime (msvcrt.dll not msvcrtd.dll # or libcmt.lib not libcmtd.lib). # time64bit = Forces a build using 64-bit time_t for 32-bit build # (CRT library should support this). # utfmax = Forces Tcl_UniChar to be a 32-bit quantity in stead # of 16-bits # # STATS=compdbg,memdbg,none # Sets optional memory and bytecode compiler debugging code added # to the core. The default is for none. Any combination of the # above may be used (comma separated). 'none' will over-ride # everything to nothing. # # compdbg = Enables byte compilation logging. # memdbg = Enables the debugging memory allocator. # # CHECKS=64bit,fullwarn,nodep,none # Sets special macros for checking compatibility. # # 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. # nodep = Turns off compatibility macros to ensure the core # isn't being built with deprecated functions. # # MACHINE=(ALPHA|AMD64|IA64|IX86) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default # when not specified. If the CPU environment variable has been # set (ie: recent Platform SDK) then MACHINE is set from CPU. # # TMP_DIR=<path> # OUT_DIR=<path> # Hooks to allow the intermediate and output directories to be # changed. $(OUT_DIR) is assumed to be # $(BINROOT)\(Release|Debug) based on if symbols are requested. # $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default. # # TESTPAT=<file> # Reads the tests requested to be run from this file. # # CFG_ENCODING=encoding # name of encoding for configuration information. Defaults # to cp1252 # # Examples: # c:\tcl_src\win\>nmake -f makefile.vc release # c:\tcl_src\win\>nmake -f makefile.vc test # c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl # c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs # c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols # |
︙ | ︙ | |||
588 589 590 591 592 593 594 | #--------------------------------------------------------------------- # Build tclConfig.sh for the TEA build system. #--------------------------------------------------------------------- tclConfig: $(OUT_DIR)\tclConfig.sh # TBD - is this tclConfig.sh file ever used? The values are incorrect! | | | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 | #--------------------------------------------------------------------- # Build tclConfig.sh for the TEA build system. #--------------------------------------------------------------------- tclConfig: $(OUT_DIR)\tclConfig.sh # TBD - is this tclConfig.sh file ever used? The values are incorrect! $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @echo Creating tclConfig.sh @nmakehlp -s << $** >$@ @TCL_DLL_FILE@ $(TCLLIBNAME) @TCL_VERSION@ $(DOTVERSION) @TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION) @TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION) @TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL) |
︙ | ︙ | |||
663 664 665 666 667 668 669 | --name-prefix=TclDate \ $(GENERICDIR)/tclGetDate.y #--------------------------------------------------------------------- # Special case object file targets #--------------------------------------------------------------------- | | | | 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 | --name-prefix=TclDate \ $(GENERICDIR)/tclGetDate.y #--------------------------------------------------------------------- # Special case object file targets #--------------------------------------------------------------------- $(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(appcflags) -DTCL_TEST \ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? $(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c $(cc32) $(pkgcflags) -DTCL_ASCII_MAIN \ -Fo$@ $? $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(CCAPPCMD) $? $(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip -Fo$@ $? $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $? |
︙ | ︙ | |||
703 704 705 706 707 708 709 | -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ -DCFG_RUNTIME_DLLFILE="\"$(CFG_RUNTIME_DLLFILE:\=\\)\"" \ -DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\"" \ -Fo$@ $? | | | | | | | | 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 | -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ -DCFG_RUNTIME_DLLFILE="\"$(CFG_RUNTIME_DLLFILE:\=\\)\"" \ -DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\"" \ -Fo$@ $? $(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(appcflags) \ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? ### The following objects should be built using the stub interfaces $(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c !if $(STATIC_BUILD) $(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $? !else $(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $? !endif $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c !if $(STATIC_BUILD) $(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $? !else $(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $? !endif ### The following objects are part of the stub library and should not ### be built as DLL objects. -Zl is used to avoid a dependency on any ### specific C run-time. $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclWinPanic.obj: $(WIN_DIR)\tclWinPanic.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in @nmakehlp -s << $** >$@ @MACHINE@ $(MACHINE:IX86=X86) @TCL_WIN_VERSION@ $(DOTVERSION).0.0 << #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a # full rebuild just because some non-global header file like # tclCompile.h was changed. These rules aren't needed when building # from scratch. #--------------------------------------------------------------------- depend: !if !exist($(TCLSH)) @echo Build tclsh first! !else $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ -passthru:"-DBUILD_tcl $(TCL_INCLUDES) $(PRJ_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WIN_DIR),$$(WIN_DIR) @<< $(TCLOBJS) << !endif #--------------------------------------------------------------------- # Dependency rules #--------------------------------------------------------------------- |
︙ | ︙ | |||
799 800 801 802 803 804 805 | << {$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj:: $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<< $< << | | | 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 | << {$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj:: $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<< $< << $(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tclsh.rc #--------------------------------------------------------------------- # Installation. #--------------------------------------------------------------------- install-binaries: |
︙ | ︙ | |||
859 860 861 862 863 864 865 | @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" | | | | | | 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 | @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(WIN_DIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(WIN_DIR)\rules.vc" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WIN_DIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WIN_DIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\" @echo Installing library opt0.4 directory @$(CPY) "$(ROOT)\library\opt\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\opt0.4\" @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\http\http.tcl" \ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm" |
︙ | ︙ |
Changes to win/nmakehlp.c.
︙ | ︙ | |||
639 640 641 642 643 644 645 | *ke = 0, *ve = 0; list_insert(&substPtr, (char*)ks, (char*)vs); } fclose(sp); } /* debug: dump the list */ | | | 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 | *ke = 0, *ve = 0; list_insert(&substPtr, (char*)ks, (char*)vs); } fclose(sp); } /* debug: dump the list */ #ifndef NDEBUG { int n = 0; list_item_t *p = NULL; for (p = substPtr; p != NULL; p = p->nextPtr, ++n) { fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value); } } |
︙ | ︙ |
Changes to win/rules.vc.
︙ | ︙ | |||
20 21 22 23 24 25 26 | !ifndef _RULES_VC _RULES_VC = 1 # The following macros define the version of the rules.vc nmake build system # For modifications that are not backward-compatible, you *must* change # the major version. RULES_VERSION_MAJOR = 1 | | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | !ifndef _RULES_VC _RULES_VC = 1 # The following macros define the version of the rules.vc nmake build system # For modifications that are not backward-compatible, you *must* change # the major version. RULES_VERSION_MAJOR = 1 RULES_VERSION_MINOR = 4 # The PROJECT macro must be defined by parent makefile. !if "$(PROJECT)" == "" !error *** Error: Macro PROJECT not defined! Please define it before including rules.vc !endif !if "$(PRJ_PACKAGE_TCLNAME)" == "" |
︙ | ︙ | |||
158 159 160 161 162 163 164 | # some Tcl interfaces that are not publicly exposed. # # The fragment will set the following macros: # ROOT - root of this module sources # COMPATDIR - source directory that holds compatibility sources # DOCDIR - source directory containing documentation files # GENERICDIR - platform-independent source directory | | | 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | # some Tcl interfaces that are not publicly exposed. # # The fragment will set the following macros: # ROOT - root of this module sources # COMPATDIR - source directory that holds compatibility sources # DOCDIR - source directory containing documentation files # GENERICDIR - platform-independent source directory # WIN_DIR - Windows-specific source directory # TESTDIR - directory containing test files # TOOLSDIR - directory containing build tools # _TCLDIR - root of the Tcl installation OR the Tcl sources. Not set # when building Tcl itself. # _INSTALLDIR - native form of the installation path. For Tcl # this will be the root of the Tcl installation. For extensions # this will be the lib directory under the root. |
︙ | ︙ | |||
211 212 213 214 215 216 217 | !ifndef DEMODIR !if exist("$(LIBDIR)\demos") DEMODIR = $(LIBDIR)\demos !else DEMODIR = $(ROOT)\demos !endif !endif # ifndef DEMODIR | | | < < | | | | | 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | !ifndef DEMODIR !if exist("$(LIBDIR)\demos") DEMODIR = $(LIBDIR)\demos !else DEMODIR = $(ROOT)\demos !endif !endif # ifndef DEMODIR # Do NOT use WINDIR because it is Windows internal environment # variable to point to c:\windows! WIN_DIR = $(ROOT)\win !ifndef RCDIR !if exist("$(WIN_DIR)\rc") RCDIR = $(WIN_DIR)\rc !else RCDIR = $(WIN_DIR) !endif !endif RCDIR = $(RCDIR:/=\) # The target directory where the built packages and binaries will be installed. # INSTALLDIR is the (optional) path specified by the user. # _INSTALLDIR is INSTALLDIR using the backslash separator syntax |
︙ | ︙ | |||
682 683 684 685 686 687 688 689 690 691 692 693 694 695 | # 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) # Further, LINKERFLAGS are modified based on above. # Default values for all the above STATIC_BUILD = 0 TCL_THREADS = 1 DEBUG = 0 SYMBOLS = 0 | > > > | 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 | # 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) # _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build # (CRT library should support this) # TCL_UTF_MAX=6 - forces a build using 32-bit Tcl_UniChar in stead of 16-bit. # Further, LINKERFLAGS are modified based on above. # Default values for all the above STATIC_BUILD = 0 TCL_THREADS = 1 DEBUG = 0 SYMBOLS = 0 |
︙ | ︙ | |||
740 741 742 743 744 745 746 747 748 749 750 751 752 753 | !if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) !message *** Doing staticpkg TCL_USE_STATIC_PACKAGES = 1 !else TCL_USE_STATIC_PACKAGES = 0 !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 !else | > > > > > > > > > > | 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 | !if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) !message *** Doing staticpkg TCL_USE_STATIC_PACKAGES = 1 !else TCL_USE_STATIC_PACKAGES = 0 !endif !if [nmakehlp -f $(OPTS) "time64bit"] !message *** Force 64-bit time_t _USE_64BIT_TIME_T = 1 !endif !if [nmakehlp -f $(OPTS) "utfmax"] !message *** Force 32-bit Tcl_UniChar TCL_UTF_MAX = 6 !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 !else |
︙ | ︙ | |||
1067 1068 1069 1070 1071 1072 1073 | TCLSH = $(OUT_DIR)\$(TCLSHNAME) TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) TCLLIB = $(OUT_DIR)\$(TCLLIBNAME) TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) | | | 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 | TCLSH = $(OUT_DIR)\$(TCLSHNAME) TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) TCLLIB = $(OUT_DIR)\$(TCLLIBNAME) TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" !else # ! $(DOING_TCL) !if $(TCLINSTALL) # Building against an installed Tcl # When building extensions, we need to locate tclsh. Depending on version # of Tcl we are building against, this may or may not have a "t" suffix. |
︙ | ︙ | |||
1142 1143 1144 1145 1146 1147 1148 | TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib !if $(DOING_TK) WISH = $(OUT_DIR)\$(WISHNAME) TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME) TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME) TKLIB = $(OUT_DIR)\$(TKLIBNAME) | | | 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 | TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib !if $(DOING_TK) WISH = $(OUT_DIR)\$(WISHNAME) TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME) TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME) TKLIB = $(OUT_DIR)\$(TKLIBNAME) TK_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" !else # effectively NEED_TK !if $(TKINSTALL) # Building against installed Tk WISH = $(_TKDIR)\bin\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) |
︙ | ︙ | |||
1261 1262 1263 1264 1265 1266 1267 | !if $(TCL_MEM_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG !endif !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS !endif | | | | 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 | !if $(TCL_MEM_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG !endif !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS !endif !if $(TCL_THREADS) && $(TCL_VERSION) < 87 OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 !if $(USE_THREAD_ALLOC) && $(TCL_VERSION) < 87 OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 !endif !endif !if $(STATIC_BUILD) OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD !endif !if $(TCL_NO_DEPRECATED) |
︙ | ︙ | |||
1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 | !endif !if "$(MACHINE)" == "AMD64" OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64 !endif # _ATL_XP_TARGETING - Newer SDK's need this to build for XP COMPILERFLAGS = /D_ATL_XP_TARGETING # Following is primarily for the benefit of extensions. Tcl 8.5 builds # Tcl without /DUNICODE, while 8.6 builds with it defined. When building # an extension, it is advisable (but not mandated) to use the same Windows | > > > > > > > | 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 | !endif !if "$(MACHINE)" == "AMD64" OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64 !endif !if "$(_USE_64BIT_TIME_T)" == "1" OPTDEFINES = $(OPTDEFINES) -D_USE_64BIT_TIME_T !endif !if "$(TCL_UTF_MAX)" == "6" OPTDEFINES = $(OPTDEFINES) -DTCL_UTF_MAX=6 !endif # _ATL_XP_TARGETING - Newer SDK's need this to build for XP COMPILERFLAGS = /D_ATL_XP_TARGETING # Following is primarily for the benefit of extensions. Tcl 8.5 builds # Tcl without /DUNICODE, while 8.6 builds with it defined. When building # an extension, it is advisable (but not mandated) to use the same Windows |
︙ | ︙ | |||
1387 1388 1389 1390 1391 1392 1393 | !if $(DEBUG) # Turn warnings into errors cwarn = $(cwarn) -WX !endif INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES) !if !$(DOING_TCL) && !$(DOING_TK) | | < > | | 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 | !if $(DEBUG) # Turn warnings into errors cwarn = $(cwarn) -WX !endif INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES) !if !$(DOING_TCL) && !$(DOING_TK) INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WIN_DIR)" -I"$(COMPATDIR)" !endif # These flags are defined roughly in the order of the pre-reform # rules.vc/makefile.vc to help visually compare that the pre- and # post-reform build logs # cflags contains generic flags used for building practically all object files cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug) # appcflags contains $(cflags) and flags for building the application # object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus # flags used for building shared object files The two differ in the # BUILD_$(PROJECT) macro which should be defined only for the shared # library *implementation* and not for its caller interface appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS) pkgcflags = $(appcflags) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) # stubscflags contains $(cflags) plus flags used for building a stubs # library for the package. Note: -DSTATIC_BUILD is defined in # $(OPTDEFINES) only if the OPTS configuration indicates a static # library. However the stubs library is ALWAYS static hence included # here irrespective of the OPTS setting. # # TBD - tclvfs has a comment that stubs libs should not be compiled with -GL # without stating why. Tcl itself compiled stubs libs with this flag. # so we do not remove it from cflags. -GL may prevent extensions # compiled with one VC version to fail to link against stubs library # compiled with another VC version. Check for this and fix accordingly. stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS) # Link flags !if $(DEBUG) ldebug = -debug -debugtype:cv !else ldebug = -release -opt:ref -opt:icf,3 |
︙ | ︙ | |||
1569 1570 1571 1572 1573 1574 1575 | @echo Installing demos to '$(DEMO_INSTALL_DIR)' @if not exist "$(DEMO_INSTALL_DIR)" mkdir "$(DEMO_INSTALL_DIR)" @if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)" default-clean: @echo Cleaning $(TMP_DIR)\* ... @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) | | | | | | | | | | | | | | | | 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 | @echo Installing demos to '$(DEMO_INSTALL_DIR)' @if not exist "$(DEMO_INSTALL_DIR)" mkdir "$(DEMO_INSTALL_DIR)" @if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)" default-clean: @echo Cleaning $(TMP_DIR)\* ... @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) @echo Cleaning $(WIN_DIR)\nmakehlp.obj, nmakehlp.exe ... @if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj @if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe @if exist $(WIN_DIR)\nmakehlp.out del $(WIN_DIR)\nmakehlp.out @echo Cleaning $(WIN_DIR)\nmhlp-out.txt ... @if exist $(WIN_DIR)\nmhlp-out.txt del $(WIN_DIR)\nmhlp-out.txt @echo Cleaning $(WIN_DIR)\_junk.pch ... @if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch @echo Cleaning $(WIN_DIR)\vercl.x, vercl.i ... @if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x @if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i @echo Cleaning $(WIN_DIR)\versions.vc, version.vc ... @if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc @if exist $(WIN_DIR)\version.vc del $(WIN_DIR)\version.vc default-hose: default-clean @echo Hosing $(OUT_DIR)\* ... @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) # Only for backward compatibility default-distclean: default-hose |
︙ | ︙ | |||
1674 1675 1676 1677 1678 1679 1680 | # main application, the master makefile should define explicit rules. {$(ROOT)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << | | | | 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 | # main application, the master makefile should define explicit rules. {$(ROOT)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(WIN_DIR)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(RCDIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< {$(WIN_DIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< {$(TMP_DIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< .SUFFIXES: .SUFFIXES:.c .rc |
︙ | ︙ | |||
1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 | !if $(CONFIG_CHECK) !ifdef TCLNMAKECONFIG !include $(TCLNMAKECONFIG) !if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)" !error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)). !endif !if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG) !message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)). !endif !endif !endif # TCLNMAKECONFIG | > > > | 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 | !if $(CONFIG_CHECK) !ifdef TCLNMAKECONFIG !include $(TCLNMAKECONFIG) !if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)" !error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)). !endif !if $(TCL_VERSION) < 87 && defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC) !message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)). !endif !if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG) !message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)). !endif !endif !endif # TCLNMAKECONFIG |
︙ | ︙ |
Changes to win/tcl.dsp.
︙ | ︙ | |||
144 145 146 147 148 149 150 | # End Source File # Begin Source File SOURCE=..\compat\dlfcn.h # End Source File # Begin Source File | < < < < | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | # End Source File # Begin Source File SOURCE=..\compat\dlfcn.h # End Source File # Begin Source File SOURCE=..\compat\gettod.c # End Source File # Begin Source File SOURCE=..\compat\limits.h # End Source File # Begin Source File |
︙ | ︙ | |||
182 183 184 185 186 187 188 | SOURCE=..\compat\strncasecmp.c # End Source File # Begin Source File SOURCE=..\compat\strstr.c # End Source File | < < < < | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | SOURCE=..\compat\strncasecmp.c # End Source File # Begin Source File SOURCE=..\compat\strstr.c # End Source File # Begin Source File SOURCE=..\compat\strtol.c # End Source File # Begin Source File SOURCE=..\compat\strtoul.c |
︙ | ︙ |
Changes to win/tclWin32Dll.c.
︙ | ︙ | |||
286 287 288 289 290 291 292 | char TclWinDriveLetterForVolMountPoint( const WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; WCHAR Target[55]; /* Target of mount at mount point */ | | | 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 | char TclWinDriveLetterForVolMountPoint( const WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; WCHAR Target[55]; /* Target of mount at mount point */ WCHAR drive[4] = L"A:\\"; /* * Detect the volume mounted there. Unfortunately, there is no simple way * to map a unique volume name to a DOS drive letter. So, we have to build * an associative array. */ |
︙ | ︙ | |||
364 365 366 367 368 369 370 | dlIter = dlIter->nextPtr; } /* * We couldn't find it, so we must iterate over the letters. */ | | | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 | dlIter = dlIter->nextPtr; } /* * We couldn't find it, so we must iterate over the letters. */ for (drive[0] = 'A'; drive[0] <= 'Z'; drive[0]++) { /* * Try to read the volume mount point and see where it points. */ if (GetVolumeNameForVolumeMountPoint(drive, Target, 55) != 0) { int alreadyStored = 0; |
︙ | ︙ | |||
459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 | * * Side effects: * None. * *--------------------------------------------------------------------------- */ WCHAR * Tcl_WinUtfToTChar( const char *string, /* Source string in UTF-8. */ int len, /* Source string length in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { Tcl_DStringInit(dsPtr); | > > < < < | | < | | | < < < < < < | 459 460 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 488 489 490 491 492 493 494 495 496 497 498 | * * Side effects: * None. * *--------------------------------------------------------------------------- */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #undef Tcl_WinUtfToTChar WCHAR * Tcl_WinUtfToTChar( const char *string, /* Source string in UTF-8. */ int len, /* Source string length in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { Tcl_DStringInit(dsPtr); return Tcl_UtfToWCharDString(string, len, dsPtr); } #undef Tcl_WinTCharToUtf char * Tcl_WinTCharToUtf( const WCHAR *string, /* Source string in Unicode. */ int len, /* Source string length in bytes, or -1 for * platform-specific string length. */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { Tcl_DStringInit(dsPtr); return Tcl_WCharToUtfDString(string, len >> 1, dsPtr); } #endif /* !defined(TCL_NO_DEPRECATED) */ /* *------------------------------------------------------------------------ * * TclWinCPUID -- * * Get CPU ID information on an Intel box under Windows |
︙ | ︙ |
Changes to win/tclWinChan.c.
︙ | ︙ | |||
1567 1568 1569 1570 1571 1572 1573 | */ if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) { /* * The 4th character must be a digit 1..9 */ | | | 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 | */ if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) { /* * The 4th character must be a digit 1..9 */ if ((p[3] < '1') || (p[3] > '9')) { return 0; } return 1; } /* * 2. Look for \\.\com[0-9]+ |
︙ | ︙ |
Changes to win/tclWinConsole.c.
︙ | ︙ | |||
198 199 200 201 202 203 204 | }; /* *---------------------------------------------------------------------- * * ReadConsoleBytes, WriteConsoleBytes -- * | | | < | | < | | | 198 199 200 201 202 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 | }; /* *---------------------------------------------------------------------- * * ReadConsoleBytes, WriteConsoleBytes -- * * Wrapper for ReadConsoleW, that takes and returns number of bytes * instead of number of WCHARS. * *---------------------------------------------------------------------- */ static BOOL ReadConsoleBytes( HANDLE hConsole, LPVOID lpBuffer, DWORD nbytes, LPDWORD nbytesread) { DWORD ntchars; BOOL result; /* * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return * success with ntchars == 0 and GetLastError() will be * ERROR_OPERATION_ABORTED. We do not want to treat this case * as EOF so we will loop around again. If no Ctrl signal handlers * have been established, the default signal OS handler in a separate * thread will terminate the program. If a Ctrl signal handler * has been established (through an extension for example), it * will run and take whatever action it deems appropriate. */ do { result = ReadConsole(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, NULL); } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED); if (nbytesread != NULL) { *nbytesread = ntchars * sizeof(WCHAR); } return result; } static BOOL WriteConsoleBytes( HANDLE hConsole, const void *lpBuffer, DWORD nbytes, LPDWORD nbyteswritten) { DWORD ntchars; BOOL result; result = WriteConsole(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, NULL); if (nbyteswritten != NULL) { *nbyteswritten = ntchars * sizeof(WCHAR); } return result; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to win/tclWinDde.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclWinDde.c -- * * This file provides functions that implement the "send" command, * allowing commands to be passed from interpreter to interpreter. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #include <dde.h> #include <ddeml.h> #include <tchar.h> | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | /* * tclWinDde.c -- * * This file provides functions that implement the "send" command, * allowing commands to be passed from interpreter to interpreter. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #undef TCL_UTF_MAX #define TCL_UTF_MAX 3 #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #include <dde.h> #include <ddeml.h> #include <tchar.h> |
︙ | ︙ | |||
30 31 32 33 34 35 36 | * registered by this process. */ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ | | | 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | * registered by this process. */ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ WCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; /* * Used to keep track of conversations. */ |
︙ | ︙ | |||
95 96 97 98 99 100 101 | */ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); | | | | | | > > > > > > > > > > > | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | */ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(void *clientData); static int DdeGetServicesList(Tcl_Interp *interp, const WCHAR *serviceName, const WCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); static void DeleteProc(void *clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString #endif static unsigned char * getByteArrayFromObj( Tcl_Obj *objPtr, size_t *lengthPtr ) { int length; unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); #if TCL_MAJOR_VERSION > 8 if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { /* 64-bit and TIP #494 situation: */ *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; } else #endif /* 32-bit or without TIP #494 */ *lengthPtr = (size_t) (unsigned) length; return result; } #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); #ifdef __cplusplus } #endif /* *---------------------------------------------------------------------- * * Dde_Init -- * * This function initializes the dde command. |
︙ | ︙ | |||
155 156 157 158 159 160 161 | *---------------------------------------------------------------------- */ int Dde_Init( Tcl_Interp *interp) { | | | | 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 | *---------------------------------------------------------------------- */ int Dde_Init( Tcl_Interp *interp) { if (!Tcl_InitStubs(interp, "8.5-", 0)) { return TCL_ERROR; } Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } /* *---------------------------------------------------------------------- * * Dde_SafeInit -- * |
︙ | ︙ | |||
279 280 281 282 283 284 285 | * "send" command is created in the application's interpreter. The * registration will be removed automatically if the interpreter is * deleted or the "send" command is removed. * *---------------------------------------------------------------------- */ | | | | | 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 | * "send" command is created in the application's interpreter. The * registration will be removed automatically if the interpreter is * deleted or the "send" command is removed. * *---------------------------------------------------------------------- */ static const WCHAR * DdeSetServerName( Tcl_Interp *interp, const WCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; const WCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * See if the application is already registered; if so, remove its current * name from the registry. The deletion of the command will take care of |
︙ | ︙ | |||
351 352 353 354 355 356 357 | srvListPtr = Tcl_GetObjResult(interp); } if (r == TCL_OK) { r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount, &srvPtrPtr); } if (r != TCL_OK) { | | | | | | | | > | | | | | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 | srvListPtr = Tcl_GetObjResult(interp); } if (r == TCL_OK) { r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount, &srvPtrPtr); } if (r != TCL_OK) { Tcl_DStringInit(&dString); OutputDebugString(Tcl_UtfToWCharDString(Tcl_GetString(Tcl_GetObjResult(interp)), -1, &dString)); Tcl_DStringFree(&dString); return NULL; } /* * Pick a name to use for the application. Use "name" if it's not * already in use. Otherwise add a suffix such as " #2", trying larger * and larger numbers until we eventually find one that is unique. */ offset = lastSuffix = 0; suffix = 1; while (suffix != lastSuffix) { lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { Tcl_DStringAppend(&dString, (char *)name, wcslen(name) * sizeof(WCHAR)); Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(WCHAR)); offset = Tcl_DStringLength(&dString); Tcl_DStringSetLength(&dString, offset + sizeof(WCHAR) * TCL_INTEGER_SPACE); actualName = (WCHAR *) Tcl_DStringValue(&dString); } _snwprintf((WCHAR *) (Tcl_DStringValue(&dString) + offset), TCL_INTEGER_SPACE, TEXT("%d"), suffix); } /* * See if the name is already in use, if so increment suffix. */ for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); Tcl_DStringInit(&ds); Tcl_UtfToWCharDString(Tcl_GetString(namePtr), -1, &ds); if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); break; } Tcl_DStringFree(&ds); } } } /* * We have found a unique name. Now add it to the registry. */ riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp)); riPtr->interp = interp; riPtr->name = (WCHAR *) Tcl_Alloc((wcslen(actualName) + 1) * sizeof(WCHAR)); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; wcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); } Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, riPtr, DeleteProc); |
︙ | ︙ | |||
485 486 487 488 489 490 491 | * The interpreter given by riPtr is unregistered. * *---------------------------------------------------------------------- */ static void DeleteProc( | | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 | * The interpreter given by riPtr is unregistered. * *---------------------------------------------------------------------- */ static void DeleteProc( void *clientData) /* The interp we are deleting passed as * ClientData. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL; |
︙ | ︙ | |||
623 624 625 626 627 628 629 | * performing. */ UINT uFmt, /* The format that data is sent or received */ HCONV hConv, /* The conversation associated with the * current transaction. */ HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type * dependent. */ HDDEDATA hData, /* DDE data. Transaction-type dependent. */ | | | > > | | | | | | | 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 | * performing. */ UINT uFmt, /* The format that data is sent or received */ HCONV hConv, /* The conversation associated with the * current transaction. */ HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type * dependent. */ HDDEDATA hData, /* DDE data. Transaction-type dependent. */ DWORD unused1, DWORD unused2) /* Transaction-dependent data. */ { Tcl_DString dString; size_t len; DWORD dlen; WCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; Conversation *convPtr, *prevConvPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); (void)unused1; (void)unused2; switch(uType) { case XTYP_CONNECT: /* * Dde is trying to initialize a conversation with us. Check and make * sure we have a valid topic. */ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (_wcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } } Tcl_DStringFree(&dString); return (HDDEDATA) FALSE; case XTYP_CONNECT_CONFIRM: /* * Dde has decided that we can connect, so it gives us a conversation * handle. We need to keep track of it so we know which execution * result to return in an XTYP_REQUEST. */ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (_wcsicmp(riPtr->name, utilString) == 0) { convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; convPtr->hConv = hConv; convPtr->riPtr = riPtr; tsdPtr->currentConversations = convPtr; break; |
︙ | ︙ | |||
739 740 741 742 743 744 745 | if (convPtr != NULL) { Tcl_DString dsBuf; char *returnString; len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringInit(&dsBuf); | | | | > | | > | > | | | 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 | if (convPtr != NULL) { Tcl_DString dsBuf; char *returnString; len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringInit(&dsBuf); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { returnString = Tcl_GetString(convPtr->returnPackagePtr); len = convPtr->returnPackagePtr->length; if (uFmt != CF_TEXT) { Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; } else { Tcl_DString ds; Tcl_Obj *variableObjPtr; Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); variableObjPtr = Tcl_GetVar2Ex( convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { returnString = Tcl_GetString(variableObjPtr); len = variableObjPtr->length; if (uFmt != CF_TEXT) { Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { ddeReturn = NULL; } |
︙ | ︙ | |||
814 815 816 817 818 819 820 | Tcl_DString ds, ds2; Tcl_Obj *variableObjPtr; DWORD len2; Tcl_DStringInit(&dString); Tcl_DStringInit(&ds2); len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); | | | > | | > | | | 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 | Tcl_DString ds, ds2; Tcl_Obj *variableObjPtr; DWORD len2; Tcl_DStringInit(&dString); Tcl_DStringInit(&ds2); len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); utilString = (WCHAR *) DdeAccessData(hData, &len2); len = len2; if (uFmt != CF_TEXT) { Tcl_DStringInit(&ds2); Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2); utilString = (WCHAR *) Tcl_DStringValue(&ds2); } variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, variableObjPtr, TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds2); |
︙ | ︙ | |||
858 859 860 861 862 863 864 | */ } if (convPtr == NULL) { return (HDDEDATA) DDE_FNOTPROCESSED; } | | > | | 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 | */ } if (convPtr == NULL) { return (HDDEDATA) DDE_FNOTPROCESSED; } utilString = (WCHAR *) DdeAccessData(hData, &dlen); string = (char *) utilString; if (!dlen) { /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { /* Cannot be unicode, so assume utf-8 */ if (!string[dlen-1]) { dlen--; } ddeObjectPtr = Tcl_NewStringObj(string, dlen); } else { /* unicode */ Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(utilString, (dlen>>1) - 1, &dsBuf); ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); if (convPtr->returnPackagePtr != NULL) { |
︙ | ︙ | |||
962 963 964 965 966 967 968 | * The DDE server is deleted. * *---------------------------------------------------------------------- */ static void DdeExitProc( | | > | 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 | * The DDE server is deleted. * *---------------------------------------------------------------------- */ static void DdeExitProc( void *dummy) /* Not used. */ { (void)dummy; DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER); DdeUninitialize(ddeInstance); ddeInstance = 0; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
989 990 991 992 993 994 995 | * *---------------------------------------------------------------------- */ static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ | | | > | 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 | * *---------------------------------------------------------------------- */ static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ const WCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); if (ddeConv == (HCONV) NULL) { if (interp != NULL) { Tcl_DString dString; Tcl_DStringInit(&dString); Tcl_WCharToUtfDString(name, wcslen(name), &dString); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no registered server named \"%s\"", Tcl_DStringValue(&dString))); Tcl_DStringFree(&dString); Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); } return TCL_ERROR; } |
︙ | ︙ | |||
1044 1045 1046 1047 1048 1049 1050 | */ static int DdeCreateClient( DdeEnumServices *es) { WNDCLASSEX wc; | | | | 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 | */ static int DdeCreateClient( DdeEnumServices *es) { WNDCLASSEX wc; static const WCHAR *szDdeClientClassName = TEXT("TclEval client class"); static const WCHAR *szDdeClientWindowName = TEXT("TclEval client window"); memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; wc.cbWndExtra = sizeof(DdeEnumServices *); |
︙ | ︙ | |||
1100 1101 1102 1103 1104 1105 1106 | WPARAM wParam, LPARAM lParam) { HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); DdeEnumServices *es; | | | > | > | 1124 1125 1126 1127 1128 1129 1130 1131 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 | WPARAM wParam, LPARAM lParam) { HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); DdeEnumServices *es; WCHAR sz[255]; Tcl_DString dString; #ifdef _WIN64 es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); #else es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif if (((es->service == (ATOM)0) || (es->service == service)) && ((es->topic == (ATOM)0) || (es->topic == topic))) { Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomName(service, sz, 255); Tcl_DStringInit(&dString); Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); GlobalGetAtomName(topic, sz, 255); Tcl_DStringInit(&dString); Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); /* * Adding the hwnd as a third list element provides a unique * identifier in the case of multiple servers with the name * application and topic names. |
︙ | ︙ | |||
1168 1169 1170 1171 1172 1173 1174 | &dwResult); return TRUE; } static int DdeGetServicesList( Tcl_Interp *interp, | | | | 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 | &dwResult); return TRUE; } static int DdeGetServicesList( Tcl_Interp *interp, const WCHAR *serviceName, const WCHAR *topicName) { DdeEnumServices es; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) ? (ATOM)0 : GlobalAddAtom(serviceName); |
︙ | ︙ | |||
1261 1262 1263 1264 1265 1266 1267 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DdeObjCmd( | | | 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DdeObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", (char *) NULL}; |
︙ | ︙ | |||
1298 1299 1300 1301 1302 1303 1304 | int index, i, argIndex; size_t length; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; | | > | 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 | int index, i, argIndex; size_t length; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; const WCHAR *serviceName = NULL, *topicName = NULL; const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; Tcl_DString serviceBuf, topicBuf, itemBuf; (void)dummy; /* * Initialize DDE server/client */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); |
︙ | ︙ | |||
1458 1459 1460 1461 1462 1463 1464 | Initialize(); if (firstArg != 1) { const char *src = Tcl_GetString(objv[firstArg]); length = objv[firstArg]->length; | > | | | | > | | | > | | 1485 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 1531 1532 1533 1534 1535 1536 1537 | Initialize(); if (firstArg != 1) { const char *src = Tcl_GetString(objv[firstArg]); length = objv[firstArg]->length; Tcl_DStringInit(&serviceBuf); Tcl_UtfToWCharDString(src, length, &serviceBuf); serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR); } else { length = 0; } if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { ddeService = DdeCreateStringHandle(ddeInstance, serviceName, CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { const char *src = Tcl_GetString(objv[firstArg + 1]); length = objv[firstArg + 1]->length; Tcl_DStringInit(&topicBuf); topicName = Tcl_UtfToWCharDString(src, length, &topicBuf); length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); if (length == 0) { topicName = NULL; } else { ddeTopic = DdeCreateStringHandle(ddeInstance, topicName, CP_WINUNICODE); } } switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: serviceName = DdeSetServerName(interp, serviceName, flags, handlerPtr); if (serviceName != NULL) { Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(serviceName, wcslen(serviceName), &dsBuf); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf))); Tcl_DStringFree(&dsBuf); } else { Tcl_ResetResult(interp); } break; |
︙ | ︙ | |||
1516 1517 1518 1519 1520 1521 1522 | dataString = getByteArrayFromObj(objv[firstArg + 2], &dataLength); } else { const char *src; src = Tcl_GetString(objv[firstArg + 2]); dataLength = objv[firstArg + 2]->length; | > | | | | 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 | dataString = getByteArrayFromObj(objv[firstArg + 2], &dataLength); } else { const char *src; src = Tcl_GetString(objv[firstArg + 2]); dataLength = objv[firstArg + 2]->length; Tcl_DStringInit(&dsBuf); dataString = Tcl_UtfToWCharDString(src, dataLength, &dsBuf); dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } if (dataLength + 1 < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); Tcl_DStringFree(&dsBuf); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); |
︙ | ︙ | |||
1564 1565 1566 1567 1568 1569 1570 | SetDdeError(interp); result = TCL_ERROR; } Tcl_DStringFree(&dsBuf); break; } case DDE_REQUEST: { | | > | | | | | | | > | | > | | > | | | | 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 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 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 | SetDdeError(interp); result = TCL_ERROR; } Tcl_DStringFree(&dsBuf); break; } case DDE_REQUEST: { const WCHAR *itemString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; Tcl_DStringInit(&itemBuf); itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; goto cleanup; } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; ddeItem = DdeCreateStringHandle(ddeInstance, itemString, CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; WCHAR *dataString = (WCHAR *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { returnObjPtr = Tcl_NewByteArrayObj((BYTE *) dataString, tmp); } else { Tcl_DString dsBuf; if ((tmp >= sizeof(WCHAR)) && !dataString[tmp / sizeof(WCHAR) - 1]) { tmp -= sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf); returnObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); Tcl_SetObjResult(interp, returnObjPtr); } } else { SetDdeError(interp); result = TCL_ERROR; } } break; } case DDE_POKE: { Tcl_DString dsBuf; const WCHAR *itemString; BYTE *dataString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; Tcl_DStringInit(&itemBuf); itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; goto cleanup; } Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = (BYTE *) getByteArrayFromObj(objv[firstArg + 3], &length); } else { const char *data = Tcl_GetString(objv[firstArg + 3]); length = objv[firstArg + 3]->length; Tcl_DStringInit(&dsBuf); dataString = (BYTE *) Tcl_UtfToWCharDString(data, length, &dsBuf); length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { ddeItem = DdeCreateStringHandle(ddeInstance, itemString, CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(dataString, (DWORD) length, hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; |
︙ | ︙ | |||
1713 1714 1715 1716 1717 1718 1719 | * producing a bytecode structure that refers to other objects owned * by the target interp. If the target interp is then deleted, the * bytecode structure would be referring to deallocated objects. */ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { | | | 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 | * producing a bytecode structure that refers to other objects owned * by the target interp. If the target interp is then deleted, the * bytecode structure would be referring to deallocated objects. */ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (_wcsicmp(serviceName, riPtr->name) == 0) { break; } } if (riPtr != NULL) { Tcl_Interp *sendInterp; |
︙ | ︙ | |||
1816 1817 1818 1819 1820 1821 1822 | result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetString(objPtr); length = objPtr->length; | > | | | 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 | result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetString(objPtr); length = objPtr->length; Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(string, length, &dsBuf); string = Tcl_DStringValue(&dsBuf); length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, (DWORD) length, 0, 0, CF_UNICODETEXT, 0); Tcl_DStringFree(&dsBuf); if (flags & DDE_FLAG_ASYNC) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, |
︙ | ︙ | |||
1850 1851 1852 1853 1854 1855 1856 | SetDdeError(interp); result = TCL_ERROR; goto cleanup; } if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; | | | | | > | | 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 | SetDdeError(interp); result = TCL_ERROR; goto cleanup; } if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; WCHAR *ddeDataString; /* * The return handle has a two or four element list in it. The * first element is the return code (TCL_OK, TCL_ERROR, etc.). * The second is the result of the script. If the return code * is TCL_ERROR, then the third element is the value of the * variable "errorCode", and the fourth is the value of the * variable "errorInfo". */ length = DdeGetData(ddeData, NULL, 0, 0); ddeDataString = (WCHAR *) Tcl_Alloc(length); DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); if (length > sizeof(WCHAR)) { length -= sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(ddeDataString, length>>1, &dsBuf); resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); Tcl_Free((char *) ddeDataString); if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); |
︙ | ︙ |
Changes to win/tclWinError.c.
︙ | ︙ | |||
390 391 392 393 394 395 396 | va_start(argList, format); if (IsDebuggerPresent()) { WCHAR msgString[TCL_MAX_WARN_LEN]; char buf[TCL_MAX_WARN_LEN * 3]; vsnprintf(buf, sizeof(buf), format, argList); | | | | 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 | va_start(argList, format); if (IsDebuggerPresent()) { WCHAR msgString[TCL_MAX_WARN_LEN]; char buf[TCL_MAX_WARN_LEN * 3]; vsnprintf(buf, sizeof(buf), format, argList); msgString[TCL_MAX_WARN_LEN-1] = '\0'; MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); /* * Truncate MessageBox string if it is too long to not overflow the buffer. */ if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } OutputDebugStringW(msgString); } else { if (!isatty(fileno(stderr))) { fprintf(stderr, "\xef\xbb\xbf"); } |
︙ | ︙ |
Changes to win/tclWinFCmd.c.
︙ | ︙ | |||
324 325 326 327 328 329 330 | nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } CharLower(nativeSrcPath); CharLower(nativeDstPath); | > > | | | 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 | nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } CharLower(nativeSrcPath); CharLower(nativeDstPath); Tcl_DStringInit(&srcString); Tcl_DStringInit(&dstString); src = Tcl_WCharToUtfDString(nativeSrcPath, -1, &srcString); dst = Tcl_WCharToUtfDString(nativeDstPath, -1, &dstString); /* * Check whether the destination path is actually inside the * source path. This is true if the prefix matches, and the next * character is either end-of-string or a directory separator */ |
︙ | ︙ | |||
451 452 453 454 455 456 457 | size = GetFullPathName(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } nativeTmp = (WCHAR *) tempBuf; | | | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 | size = GetFullPathName(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } nativeTmp = (WCHAR *) tempBuf; nativeRest[0] = '\0'; result = TCL_ERROR; nativePrefix = (WCHAR *) L"tclr"; if (GetTempFileName(nativeTmp, nativePrefix, 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and |
︙ | ︙ | |||
907 908 909 910 911 912 913 | normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); if ((normSrcPtr == NULL) || (normDestPtr == NULL)) { return TCL_ERROR; } | > > | | | 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 | normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); if ((normSrcPtr == NULL) || (normDestPtr == NULL)) { return TCL_ERROR; } Tcl_DStringInit(&srcString); Tcl_DStringInit(&dstString); Tcl_UtfToWCharDString(Tcl_GetString(normSrcPtr), -1, &srcString); Tcl_UtfToWCharDString(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); if (ret != TCL_OK) { |
︙ | ︙ | |||
980 981 982 983 984 985 986 | */ Tcl_DString native; normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPtr == NULL) { return TCL_ERROR; } | > | | 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 | */ Tcl_DString native; normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPtr == NULL) { return TCL_ERROR; } Tcl_DStringInit(&native); Tcl_UtfToWCharDString(Tcl_GetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds); } if (ret != TCL_OK) { |
︙ | ︙ | |||
1105 1106 1107 1108 1109 1110 1111 | * don't want to initialise the errorPtr yet. */ return TCL_ERROR; } end: if (errorPtr != NULL) { | > > > | | 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 | * don't want to initialise the errorPtr yet. */ return TCL_ERROR; } end: if (errorPtr != NULL) { char *p; Tcl_DStringInit(errorPtr); p = Tcl_WCharToUtfDString(nativePath, -1, errorPtr); for (; *p; ++p) { if (*p == '\\') *p = '/'; } } return TCL_ERROR; } |
︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 | DOTREE_POSTD, errorPtr); } end: if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { | > | | 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 | DOTREE_POSTD, errorPtr); } end: if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { Tcl_DStringInit(errorPtr); Tcl_WCharToUtfDString(nativeErrfile, -1, errorPtr); } result = TCL_ERROR; } return result; } |
︙ | ︙ | |||
1384 1385 1386 1387 1388 1389 1390 | /* * There shouldn't be a problem with src, because we already checked it to * get here. */ if (errorPtr != NULL) { | > | | 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 | /* * There shouldn't be a problem with src, because we already checked it to * get here. */ if (errorPtr != NULL) { Tcl_DStringInit(errorPtr); Tcl_WCharToUtfDString(nativeDst, -1, errorPtr); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1439 1440 1441 1442 1443 1444 1445 | if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { return TCL_OK; } break; } if (errorPtr != NULL) { | > | | 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 | if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { return TCL_OK; } break; } if (errorPtr != NULL) { Tcl_DStringInit(errorPtr); Tcl_WCharToUtfDString(nativeSrc, -1, errorPtr); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1647 1648 1649 1650 1651 1652 1653 | /* * We'd like to call Tcl_FSGetNativePath(tempPath) but that is * likely to lead to infinite loops. */ tempString = TclGetStringFromObj(tempPath, &length); | > | | 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 | /* * We'd like to call Tcl_FSGetNativePath(tempPath) but that is * likely to lead to infinite loops. */ tempString = TclGetStringFromObj(tempPath, &length); Tcl_DStringInit(&ds); nativeName = Tcl_UtfToWCharDString(tempString, length, &ds); Tcl_DecrRefCount(tempPath); handle = FindFirstFile(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* * FindFirstFile() doesn't like root directories. We would * only get a root directory here if the caller specified "c:" * or "c:." and the current directory on the drive was the |
︙ | ︙ | |||
1684 1685 1686 1687 1688 1689 1690 | } else { if (data.cAlternateFileName[0] == '\0') { nativeName = (WCHAR *) data.cFileName; } } /* | | | | 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 | } else { if (data.cAlternateFileName[0] == '\0') { nativeName = (WCHAR *) data.cFileName; } } /* * Purify reports a extraneous UMR in Tcl_WCharToUtfDString() trying * to dereference nativeName as a Unicode string. I have proven to * myself that purify is wrong by running the following example * when nativeName == data.w.cAlternateFileName and noting that * purify doesn't complain about the first line, but does complain * about the second. * * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]); * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); */ Tcl_DStringInit(&dsTemp); Tcl_WCharToUtfDString(nativeName, -1, &dsTemp); Tcl_DStringFree(&ds); /* * Deal with issues of tildes being absolute. */ if (Tcl_DStringValue(&dsTemp)[0] == '~') { |
︙ | ︙ | |||
1991 1992 1993 1994 1995 1996 1997 | */ if (dirObj) { Tcl_GetString(dirObj); if (dirObj->length < 1) { goto useSystemTemp; } | > | | | < < | | | 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 | */ if (dirObj) { Tcl_GetString(dirObj); if (dirObj->length < 1) { goto useSystemTemp; } Tcl_DStringInit(&base); Tcl_UtfToWCharDString(Tcl_GetString(dirObj), -1, &base); if (dirObj->bytes[dirObj->length - 1] != '\\') { Tcl_UtfToWCharDString("\\", -1, &base); } } else { useSystemTemp: Tcl_DStringInit(&base); Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR)); } /* * Next, the base of the directory name. */ #define DEFAULT_TEMP_DIR_PREFIX "tcl" #define SUFFIX_LENGTH 8 if (basenameObj) { Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), -1, &base); } else { Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, -1, &base); } Tcl_UtfToWCharDString("_", -1, &base); /* * Now we keep on trying random suffixes until we get one that works * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a * case-sensitive filesystem. */ |
︙ | ︙ | |||
2042 2043 2044 2045 2046 2047 2048 | error = ERROR_SUCCESS; tempbuf[SUFFIX_LENGTH] = '\0'; for (i = 0 ; i < SUFFIX_LENGTH; i++) { tempbuf[i] = randChars[(int) (rand() % numRandChars)]; } Tcl_DStringSetLength(&base, baseLen); | | > | | 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 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 | error = ERROR_SUCCESS; tempbuf[SUFFIX_LENGTH] = '\0'; for (i = 0 ; i < SUFFIX_LENGTH; i++) { tempbuf[i] = randChars[(int) (rand() % numRandChars)]; } Tcl_DStringSetLength(&base, baseLen); Tcl_UtfToWCharDString(tempbuf, -1, &base); } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL) && (error = GetLastError()) == ERROR_ALREADY_EXISTS); /* * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and * ERROR_ACCESS_DENIED. */ if (error != ERROR_SUCCESS) { TclWinConvertError(error); Tcl_DStringFree(&base); return NULL; } /* * We actually made the directory, so we're done! Report what we made back * as a (clean) Tcl_Obj. */ Tcl_DStringInit(&name); Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), -1, &name); Tcl_DStringFree(&base); return TclDStringToObj(&name); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to win/tclWinFile.c.
︙ | ︙ | |||
391 392 393 394 395 396 397 | /* * We must have backslashes only. This is VERY IMPORTANT. If we have any * forward slashes everything appears to work, but the resulting symlink * is useless! */ for (loop = nativeTarget; *loop != 0; loop++) { | | | | | 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 | /* * We must have backslashes only. This is VERY IMPORTANT. If we have any * forward slashes everything appears to work, but the resulting symlink * is useless! */ for (loop = nativeTarget; *loop != 0; loop++) { if (*loop == '/') { *loop = '\\'; } } if ((nativeTarget[len-1] == '\\') && (nativeTarget[len-2] != ':')) { nativeTarget[len-1] = 0; } /* * Build the reparse info. */ |
︙ | ︙ | |||
568 569 570 571 572 573 574 | * There is an assumption in this code that 'wide' interfaces are * being used (see tclWin32Dll.c), which is true for the only systems * which support reparse tags at present. If that changes in the * future, this code will have to be generalised. */ offset = 0; | | | | 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 | * There is an assumption in this code that 'wide' interfaces are * being used (see tclWin32Dll.c), which is true for the only systems * which support reparse tags at present. If that changes in the * future, this code will have to be generalised. */ offset = 0; if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == '\\') { /* * Check whether this is a mounted volume. */ if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer, L"\\??\\Volume{",11) == 0) { char drive; /* * There is some confusion between \??\ and \\?\ which we have * to fix here. It doesn't seem very well documented. */ reparseBuffer->MountPointReparseBuffer.PathBuffer[1] = '\\'; /* * Check if a corresponding drive letter exists, and use that * if it is found */ drive = TclWinDriveLetterForVolMountPoint( |
︙ | ︙ | |||
630 631 632 633 634 635 636 | * Strip off the prefix. */ offset = 4; } } | > | | | 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 | * Strip off the prefix. */ offset = 4; } } Tcl_DStringInit(&ds); Tcl_WCharToUtfDString( reparseBuffer->MountPointReparseBuffer.PathBuffer, reparseBuffer->MountPointReparseBuffer .SubstituteNameLength>>1, &ds); copy = Tcl_DStringValue(&ds)+offset; len = Tcl_DStringLength(&ds)-offset; retVal = Tcl_NewStringObj(copy,len); Tcl_IncrRefCount(retVal); Tcl_DStringFree(&ds); return retVal; |
︙ | ︙ | |||
810 811 812 813 814 815 816 | va_list argList; char buf[TCL_MAX_WARN_LEN * 3]; WCHAR msgString[TCL_MAX_WARN_LEN]; va_start(argList, format); vsnprintf(buf, sizeof(buf), format, argList); | | | | 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 | va_list argList; char buf[TCL_MAX_WARN_LEN * 3]; WCHAR msgString[TCL_MAX_WARN_LEN]; va_start(argList, format); vsnprintf(buf, sizeof(buf), format, argList); msgString[TCL_MAX_WARN_LEN-1] = '\0'; MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); /* * Truncate MessageBox string if it is too long to not overflow the screen * and cause possible oversized window error. */ if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } if (IsDebuggerPresent()) { OutputDebugStringW(msgString); } else { MessageBeep(MB_ICONEXCLAMATION); MessageBoxW(NULL, msgString, L"Fatal Error", |
︙ | ︙ | |||
1019 1020 1021 1022 1023 1024 1025 | */ dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } | > | | 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 | */ dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } Tcl_DStringInit(&ds); native = Tcl_UtfToWCharDString(dirName, -1, &ds); if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { handle = FindFirstFile(native, &data); } else { /* * We can be more efficient, for pure directory requests. */ |
︙ | ︙ | |||
1092 1093 1094 1095 1096 1097 1098 | do { const char *utfname; int checkDrive = 0, isDrive; DWORD attr; native = data.cFileName; attr = data.dwFileAttributes; | > | | 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 | do { const char *utfname; int checkDrive = 0, isDrive; DWORD attr; native = data.cFileName; attr = data.dwFileAttributes; Tcl_DStringInit(&ds); utfname = Tcl_WCharToUtfDString(native, -1, &ds); if (!matchSpecialDots) { /* * If it is exactly '.' or '..' then we ignore it. */ if ((utfname[0] == '.') && (utfname[1] == '\0' |
︙ | ︙ | |||
1467 1468 1469 1470 1471 1472 1473 | rc = 1; result = Tcl_DStringValue(bufferPtr); } } Tcl_DStringFree(&ds); } else { Tcl_DStringInit(&ds); | | | | 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 | rc = 1; result = Tcl_DStringValue(bufferPtr); } } Tcl_DStringFree(&ds); } else { Tcl_DStringInit(&ds); wName = Tcl_UtfToWCharDString(domain + 1, -1, &ds); rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain); Tcl_DStringFree(&ds); nameLen = domain - name; } if (rc == 0) { Tcl_DStringInit(&ds); wName = Tcl_UtfToWCharDString(name, nameLen, &ds); while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) { /* * User does not exist; if domain was not specified, try again * using current domain. */ rc = 1; |
︙ | ︙ | |||
1500 1501 1502 1503 1504 1505 1506 | } domain = INT2PTR(-1); /* repeat once */ } if (rc == 0) { DWORD i, size = MAX_PATH; wHomeDir = uiPtr->usri1_home_dir; | | | | | 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 | } domain = INT2PTR(-1); /* repeat once */ } if (rc == 0) { DWORD i, size = MAX_PATH; wHomeDir = uiPtr->usri1_home_dir; if ((wHomeDir != NULL) && (wHomeDir[0] != '\0')) { size = lstrlenW(wHomeDir); Tcl_WCharToUtfDString(wHomeDir, size, bufferPtr); } else { /* * User exists but has no home dir. Return * "{GetProfilesDirectory}/<user>". */ GetProfilesDirectoryW(buf, &size); Tcl_WCharToUtfDString(buf, size-1, bufferPtr); Tcl_DStringAppend(bufferPtr, "/", 1); Tcl_DStringAppend(bufferPtr, name, nameLen); } result = Tcl_DStringValue(bufferPtr); /* * Be sure we return normalized path |
︙ | ︙ | |||
1880 1881 1882 1883 1884 1885 1886 | } if (path[len-4] != '.') { return 0; } path += len-3; | | | | | | | 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 | } if (path[len-4] != '.') { return 0; } path += len-3; if ((_wcsicmp(path, L"exe") == 0) || (_wcsicmp(path, L"com") == 0) || (_wcsicmp(path, L"cmd") == 0) || (_wcsicmp(path, L"cmd") == 0) || (_wcsicmp(path, L"bat") == 0)) { return 1; } return 0; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1978 1979 1980 1981 1982 1983 1984 | */ native = (WCHAR *) buffer; if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; } | > | | 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 | */ native = (WCHAR *) buffer; if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; } Tcl_DStringInit(bufferPtr); Tcl_WCharToUtfDString(native, -1, bufferPtr); /* * Convert to forward slashes for easier use in scripts. */ for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '\\') { |
︙ | ︙ | |||
2186 2187 2188 2189 2190 2191 2192 | int dev; Tcl_DString ds; WCHAR nativeFullPath[MAX_PATH]; WCHAR *nativePart; const char *fullPath; GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart); | > | > | | 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 | int dev; Tcl_DString ds; WCHAR nativeFullPath[MAX_PATH]; WCHAR *nativePart; const char *fullPath; GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart); Tcl_DStringInit(&ds); fullPath = Tcl_WCharToUtfDString(nativeFullPath, -1, &ds); if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { const char *p; DWORD dw; const WCHAR *nativeVol; Tcl_DString volString; p = strchr(fullPath + 2, '\\'); p = strchr(p + 1, '\\'); if (p == NULL) { /* * Add terminating backslash to fullpath or GetVolumeInformation() * won't work. */ fullPath = TclDStringAppendLiteral(&ds, "\\"); p = fullPath + Tcl_DStringLength(&ds); } else { p++; } Tcl_DStringInit(&volString); nativeVol = Tcl_UtfToWCharDString(fullPath, p - fullPath, &volString); dw = (DWORD) -1; GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); /* * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", * but GetVolumeInformation() returns failure for "\\.\NUL". This will * cause "NUL" to get a drive number of -1, which makes about as much |
︙ | ︙ | |||
2487 2488 2489 2490 2491 2492 2493 | } if (found == 0) { return NULL; } else { Tcl_DString ds; | > | | 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 | } if (found == 0) { return NULL; } else { Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(volType, -1, &ds); return TclDStringToObj(&ds); } #undef VOL_BUF_SIZE } /* * This define can be turned on to experiment with a different way of |
︙ | ︙ | |||
2557 2558 2559 2560 2561 2562 2563 | if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { /* * Reached directory separator, or end of string. */ WIN32_FILE_ATTRIBUTE_DATA data; | | > > > | 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 | if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { /* * Reached directory separator, or end of string. */ WIN32_FILE_ATTRIBUTE_DATA data; const WCHAR *nativePath; Tcl_DStringInit(&ds); nativePath = Tcl_UtfToWCharDString(path, currentPathEndPosition - path, &ds); if (GetFileAttributesEx(nativePath, GetFileExInfoStandard, &data) != TRUE) { /* * File doesn't exist. */ |
︙ | ︙ | |||
2579 2580 2581 2582 2583 2584 2585 | */ int i; for (i=0 ; i<len ; i++) { WCHAR wc = ((WCHAR *) nativePath)[i]; | | | | 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 | */ int i; for (i=0 ; i<len ; i++) { WCHAR wc = ((WCHAR *) nativePath)[i]; if (wc >= 'a') { wc -= ('a' - 'A'); ((WCHAR *) nativePath)[i] = wc; } } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, (int)(sizeof(WCHAR) * len)); lastValidPathEnd = currentPathEndPosition; |
︙ | ︙ | |||
2670 2671 2672 2673 2674 2675 2676 | * and append it to 'dsNorm' which holds the current normalized * path */ if (isDrive) { WCHAR drive = ((WCHAR *) nativePath)[0]; | | | | 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 | * and append it to 'dsNorm' which holds the current normalized * path */ if (isDrive) { WCHAR drive = ((WCHAR *) nativePath)[0]; if (drive >= 'a') { drive -= ('a' - 'A'); ((WCHAR *) nativePath)[0] = drive; } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, Tcl_DStringLength(&ds)); } else { char *checkDots = NULL; |
︙ | ︙ | |||
2759 2760 2761 2762 2763 2764 2765 | #ifdef TclNORM_LONG_PATH /* * Convert the entire known path to long form. */ if (1) { WCHAR wpath[MAX_PATH]; | | > > > > | | < | | > | | | 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 | #ifdef TclNORM_LONG_PATH /* * Convert the entire known path to long form. */ if (1) { WCHAR wpath[MAX_PATH]; const WCHAR *nativePath; DWORD wpathlen; Tcl_DStringInit(&ds); nativePath = Tcl_UtfToWCharDString(path, lastValidPathEnd - path, &ds); wpathlen = GetLongPathNameProc(nativePath, (WCHAR *) wpath, MAX_PATH); /* * We have to make the drive letter uppercase. */ if (wpath[0] >= 'a') { wpath[0] -= ('a' - 'A'); } Tcl_DStringAppend(&dsNorm, (const char *) wpath, wpathlen * sizeof(WCHAR)); Tcl_DStringFree(&ds); } #endif /* TclNORM_LONG_PATH */ } /* * Common code path for all Windows platforms. */ nextCheckpoint = currentPathEndPosition - path; if (lastValidPathEnd != NULL) { /* * Concatenate the normalized string in dsNorm with the tail of the * path which we didn't recognise. The string in dsNorm is in the * native encoding, so we have to convert it to Utf. */ Tcl_DStringInit(&ds); Tcl_WCharToUtfDString((const WCHAR *) Tcl_DStringValue(&dsNorm), Tcl_DStringLength(&dsNorm)>>1, &ds); nextCheckpoint = Tcl_DStringLength(&ds); if (*lastValidPathEnd != 0) { /* * Not the end of the string. */ int len; |
︙ | ︙ | |||
2966 2967 2968 2969 2970 2971 2972 | ClientData clientData) { Tcl_DString ds; Tcl_Obj *objPtr; int len; char *copy, *p; | > | | 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 | ClientData clientData) { Tcl_DString ds; Tcl_Obj *objPtr; int len; char *copy, *p; Tcl_DStringInit(&ds); Tcl_WCharToUtfDString((const WCHAR *) clientData, -1, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); /* * Certain native path representations on Windows have this special prefix * to indicate that they are to be treated specially. For example * extremely long paths, or symlinks. |
︙ | ︙ |
Changes to win/tclWinInit.c.
︙ | ︙ | |||
109 110 111 112 113 114 115 | static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib); /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * | | | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib); /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * * Initialize all the platform-dependent things like signals, * floating-point error handling and sockets. * * Called at process initialization time. * * Results: * None. * |
︙ | ︙ | |||
472 473 474 475 476 477 478 | WCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; if (!GetUserName(szUserName, &cchUserNameLen)) { return NULL; } cchUserNameLen--; | | | | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 | WCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; if (!GetUserName(szUserName, &cchUserNameLen)) { return NULL; } cchUserNameLen--; Tcl_DStringInit(bufferPtr); Tcl_WCharToUtfDString(szUserName, cchUserNameLen, bufferPtr); } return Tcl_DStringValue(bufferPtr); } /* *--------------------------------------------------------------------------- * |
︙ | ︙ | |||
539 540 541 542 543 544 545 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", processors[sys.oemId.wProcessorArchitecture], TCL_GLOBAL_ONLY); } | | | 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", processors[sys.oemId.wProcessorArchitecture], TCL_GLOBAL_ONLY); } #ifndef NDEBUG /* * The existence of the "debug" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with debug * information. Using "info exists tcl_platform(debug)" a Tcl script can * direct the interpreter to load debug versions of DLLs with the load * command. */ |
︙ | ︙ | |||
624 625 626 627 628 629 630 | * (UTF-8). */ int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { int i, length, result = -1; | | | 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 | * (UTF-8). */ int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { int i, length, result = -1; const char *env, *p1, *p2; char *envUpper, *nameUpper; Tcl_DString envString; /* * Convert the name to all upper case for the case insensitive comparison. */ |
︙ | ︙ |
Changes to win/tclWinInt.h.
︙ | ︙ | |||
54 55 56 57 58 59 60 | char *channelName, int permissions); MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName, int permissions, int appendMode); MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, char *channelName, int permissions); MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const WCHAR *name, DWORD access); | | | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | char *channelName, int permissions); MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName, int permissions, int appendMode); MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, char *channelName, int permissions); MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const WCHAR *name, DWORD access); MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, const WCHAR *LinkCopy); MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); /* Needed by tclWinFile.c and tclWinFCmd.c */ #ifndef FILE_ATTRIBUTE_REPARSE_POINT |
︙ | ︙ |
Changes to win/tclWinLoad.c.
︙ | ︙ | |||
60 61 62 63 64 65 66 | Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { HINSTANCE hInstance = NULL; | | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ int flags) { HINSTANCE hInstance = NULL; const WCHAR *nativeName; Tcl_LoadHandle handlePtr; DWORD firstError; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. |
︙ | ︙ | |||
91 92 93 94 95 96 97 | /* * Remember the first error on load attempt to be used if the * second load attempt below also fails. */ firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); | > | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | /* * Remember the first error on load attempt to be used if the * second load attempt below also fails. */ firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); Tcl_DStringInit(&ds); nativeName = Tcl_UtfToWCharDString(Tcl_GetString(pathPtr), -1, &ds); hInstance = LoadLibraryEx(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } if (hInstance == NULL) { DWORD lastError; |
︙ | ︙ |
Changes to win/tclWinNotify.c.
︙ | ︙ | |||
45 46 47 48 49 50 51 | * The following static indicates the number of threads that have initialized * notifiers. It controls the lifetime of the TclNotifier window class. * * You must hold the notifierMutex lock before accessing this variable. */ static int notifierCount = 0; | | | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | * The following static indicates the number of threads that have initialized * notifiers. It controls the lifetime of the TclNotifier window class. * * You must hold the notifierMutex lock before accessing this variable. */ static int notifierCount = 0; static const WCHAR className[] = L"TclNotifier"; static int initialized = 0; static CRITICAL_SECTION notifierMutex; /* * Static routines defined in this file. */ |
︙ | ︙ | |||
79 80 81 82 83 84 85 | ClientData Tcl_InitNotifier(void) { if (tclNotifierHooks.initNotifierProc) { return tclNotifierHooks.initNotifierProc(); } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); | < > > | | | | | | | | | | | | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | ClientData Tcl_InitNotifier(void) { if (tclNotifierHooks.initNotifierProc) { return tclNotifierHooks.initNotifierProc(); } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); TclpMasterLock(); if (!initialized) { initialized = 1; InitializeCriticalSection(¬ifierMutex); } TclpMasterUnlock(); /* * Register Notifier window class if this is the first thread to use * this module. */ EnterCriticalSection(¬ifierMutex); if (notifierCount == 0) { WNDCLASS clazz; clazz.style = 0; clazz.cbClsExtra = 0; clazz.cbWndExtra = 0; clazz.hInstance = TclWinGetTclInstance(); clazz.hbrBackground = NULL; clazz.lpszMenuName = NULL; clazz.lpszClassName = className; clazz.lpfnWndProc = NotifierProc; clazz.hIcon = NULL; clazz.hCursor = NULL; if (!RegisterClass(&clazz)) { Tcl_Panic("Unable to register TclNotifier window class"); } } notifierCount++; LeaveCriticalSection(¬ifierMutex); tsdPtr->pending = 0; |
︙ | ︙ |
Changes to win/tclWinPanic.c.
︙ | ︙ | |||
38 39 40 41 42 43 44 | char buf[TCL_MAX_WARN_LEN * 3]; HANDLE handle = GetStdHandle(STD_ERROR_HANDLE); DWORD dummy; va_start(argList, format); vsnprintf(buf+3, sizeof(buf)-3, format, argList); buf[sizeof(buf)-1] = 0; | | | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | char buf[TCL_MAX_WARN_LEN * 3]; HANDLE handle = GetStdHandle(STD_ERROR_HANDLE); DWORD dummy; va_start(argList, format); vsnprintf(buf+3, sizeof(buf)-3, format, argList); buf[sizeof(buf)-1] = 0; msgString[TCL_MAX_WARN_LEN-1] = '\0'; MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN); /* * Truncate MessageBox string if it is too long to not overflow the buffer. */ if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } if (IsDebuggerPresent()) { OutputDebugStringW(msgString); } else if (_isatty(2)) { WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0); |
︙ | ︙ |
Changes to win/tclWinPipe.c.
︙ | ︙ | |||
573 574 575 576 577 578 579 | createMode = TRUNCATE_EXISTING; break; default: createMode = OPEN_EXISTING; break; } | > | | 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 | createMode = TRUNCATE_EXISTING; break; default: createMode = OPEN_EXISTING; break; } Tcl_DStringInit(&ds); nativePath = Tcl_UtfToWCharDString(path, -1, &ds); /* * If the file is not being created, use the existing file attributes. */ flags = 0; if (!(mode & O_CREAT)) { |
︙ | ︙ | |||
1286 1287 1288 1289 1290 1291 1292 | Tcl_DStringInit(&nameBuf); Tcl_DStringAppend(&nameBuf, originalName, -1); nameLen = Tcl_DStringLength(&nameBuf); for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { Tcl_DStringSetLength(&nameBuf, nameLen); Tcl_DStringAppend(&nameBuf, extensions[i], -1); | > | > | | 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 | Tcl_DStringInit(&nameBuf); Tcl_DStringAppend(&nameBuf, originalName, -1); nameLen = Tcl_DStringLength(&nameBuf); for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { Tcl_DStringSetLength(&nameBuf, nameLen); Tcl_DStringAppend(&nameBuf, extensions[i], -1); Tcl_DStringInit(&ds); nativeName = Tcl_UtfToWCharDString(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); found = SearchPath(NULL, nativeName, NULL, MAX_PATH, nativeFullPath, &rest); Tcl_DStringFree(&ds); if (found == 0) { continue; } /* * Ignore matches on directories or data files, return if identified a * known type. */ attr = GetFileAttributes(nativeFullPath); if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { continue; } Tcl_DStringInit(&ds); strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); if ((ext != NULL) && (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) { applType = APPL_DOS; break; |
︙ | ︙ | |||
1395 1396 1397 1398 1399 1400 1401 | * Replace long path name of executable with short path name for * 16-bit applications. Otherwise the application may not be able to * correctly parse its own command line to separate off the * application name from the arguments. */ GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH); | > | | 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 | * Replace long path name of executable with short path name for * 16-bit applications. Otherwise the application may not be able to * correctly parse its own command line to separate off the * application name from the arguments. */ GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH); Tcl_DStringInit(&ds); strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); } return applType; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1723 1724 1725 1726 1727 1728 1729 | * End of argument (main closing quote-char) */ TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); | > | | 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 | * End of argument (main closing quote-char) */ TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); Tcl_DStringInit(linePtr); Tcl_UtfToWCharDString(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); Tcl_DStringFree(&ds); } /* *---------------------------------------------------------------------- * * TclpCreateCommandChannel -- |
︙ | ︙ | |||
3205 3206 3207 3208 3209 3210 3211 | if (length == 0) { goto gotError; } namePtr += length * sizeof(WCHAR); if (basenameObj) { const char *string = TclGetStringFromObj(basenameObj, &length); | > | > | | 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 | if (length == 0) { goto gotError; } namePtr += length * sizeof(WCHAR); if (basenameObj) { const char *string = TclGetStringFromObj(basenameObj, &length); Tcl_DStringInit(&buf); Tcl_UtfToWCharDString(string, length, &buf); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); namePtr += Tcl_DStringLength(&buf); Tcl_DStringFree(&buf); } else { const WCHAR *baseStr = L"TCL"; length = 3 * sizeof(WCHAR); memcpy(namePtr, baseStr, length); namePtr += length; } counter = TclpGetClicks() % 65533; counter2 = 1024; /* Only try this many times! Prevents * an infinite loop. */ do { char number[TCL_INTEGER_SPACE + 4]; sprintf(number, "%d.TMP", counter); counter = (unsigned short) (counter + 1); Tcl_DStringInit(&buf); Tcl_UtfToWCharDString(number, strlen(number), &buf); Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); handle = CreateFile(name, GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL); } while (handle == INVALID_HANDLE_VALUE |
︙ | ︙ | |||
3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 | case PTI_STATE_IDLE: /* * Thread was idle/waiting, notify it goes teardown */ SetEvent(evControl); *pipeTIPtr = NULL; case PTI_STATE_DOWN: return 1; default: /* * Thread works currently, we should try to end it, own the TI * structure (because of possible sharing the joint structures with | > | 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 | case PTI_STATE_IDLE: /* * Thread was idle/waiting, notify it goes teardown */ SetEvent(evControl); *pipeTIPtr = NULL; /* FALLTHRU */ case PTI_STATE_DOWN: return 1; default: /* * Thread works currently, we should try to end it, own the TI * structure (because of possible sharing the joint structures with |
︙ | ︙ |
Changes to win/tclWinPort.h.
︙ | ︙ | |||
10 11 12 13 14 15 16 | * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLWINPORT #define _TCLWINPORT | > | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLWINPORT #define _TCLWINPORT #if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) /* See [Bug 3354324]: file mtime sets wrong time */ # define __MINGW_USE_VC2005_COMPAT #endif /* * We must specify the lower version we intend to support. * * WINVER = 0x0500 means Windows 2000 and above */ |
︙ | ︙ |
Changes to win/tclWinReg.c.
︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") #endif | > > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #undef TCL_UTF_MAX #define TCL_UTF_MAX 3 #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") #endif |
︙ | ︙ | |||
90 91 92 93 94 95 96 | * Declarations for functions defined in this file. */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); static int BroadcastValue(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); | | | 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | * Declarations for functions defined in this file. */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); static int BroadcastValue(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); static void DeleteCmd(void *clientData); static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, REGSAM mode); static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *patternObj, REGSAM mode); static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj, |
︙ | ︙ | |||
112 113 114 115 116 117 118 | static DWORD OpenSubKey(char *hostName, HKEY rootKey, char *keyName, REGSAM mode, int flags, HKEY *keyPtr); static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, | | | > > > > > > > > > > > | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | static DWORD OpenSubKey(char *hostName, HKEY rootKey, char *keyName, REGSAM mode, int flags, HKEY *keyPtr); static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, const WCHAR * pKeyName, REGSAM mode); static int RegistryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); #if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString #endif static unsigned char * getByteArrayFromObj( Tcl_Obj *objPtr, size_t *lengthPtr ) { int length; unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); #if TCL_MAJOR_VERSION > 8 if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { /* 64-bit and TIP #494 situation: */ *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; } else #endif /* 32-bit or without TIP #494 */ *lengthPtr = (size_t) (unsigned) length; return result; } #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Registry_Init(Tcl_Interp *interp); DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); #ifdef __cplusplus } #endif /* *---------------------------------------------------------------------- * * Registry_Init -- * * This function initializes the registry command. |
︙ | ︙ | |||
164 165 166 167 168 169 170 | int Registry_Init( Tcl_Interp *interp) { Tcl_Command cmd; | | | | 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | int Registry_Init( Tcl_Interp *interp) { Tcl_Command cmd; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); return Tcl_PkgProvideEx(interp, "registry", "1.3.3", NULL); } /* *---------------------------------------------------------------------- * * Registry_Unload -- * |
︙ | ︙ | |||
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | int Registry_Unload( Tcl_Interp *interp, /* Interpreter for unloading */ int flags) /* Flags passed by the unload system */ { Tcl_Command cmd; Tcl_Obj *objv[3]; /* * Unregister the registry package. There is no Tcl_PkgForget() */ objv[0] = Tcl_NewStringObj("package", -1); objv[1] = Tcl_NewStringObj("forget", -1); objv[2] = Tcl_NewStringObj("registry", -1); Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL); /* * Delete the originally registered command. */ | > | | 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 | int Registry_Unload( Tcl_Interp *interp, /* Interpreter for unloading */ int flags) /* Flags passed by the unload system */ { Tcl_Command cmd; Tcl_Obj *objv[3]; (void)flags; /* * Unregister the registry package. There is no Tcl_PkgForget() */ objv[0] = Tcl_NewStringObj("package", -1); objv[1] = Tcl_NewStringObj("forget", -1); objv[2] = Tcl_NewStringObj("registry", -1); Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL); /* * Delete the originally registered command. */ cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); if (cmd != NULL) { Tcl_DeleteCommandFromToken(interp, cmd); } return TCL_OK; } |
︙ | ︙ | |||
238 239 240 241 242 243 244 | * The unload command will not attempt to delete this command. * *---------------------------------------------------------------------- */ static void DeleteCmd( | | | | 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 | * The unload command will not attempt to delete this command. * *---------------------------------------------------------------------- */ static void DeleteCmd( void *clientData) { Tcl_Interp *interp = (Tcl_Interp *)clientData; Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
263 264 265 266 267 268 269 | * None. * *---------------------------------------------------------------------- */ static int RegistryObjCmd( | | > | 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 | * None. * *---------------------------------------------------------------------- */ static int RegistryObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { int n = 1; int index, argc; REGSAM mode = 0; const char *errString = NULL; static const char *const subcommands[] = { "broadcast", "delete", "get", "keys", "set", "type", "values", NULL }; enum SubCmdIdx { BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx }; static const char *const modes[] = { "-32bit", "-64bit", NULL }; (void)dummy; if (objc < 2) { wrongArgs: Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
411 412 413 414 415 416 417 | static int DeleteKey( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key to delete. */ REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; | | | 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 | static int DeleteKey( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key to delete. */ REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; const WCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; Tcl_DString buf; REGSAM saveMode = mode; /* * Find the parent of the key being deleted and open it. |
︙ | ︙ | |||
464 465 466 467 468 469 470 | return TCL_ERROR; } /* * Now we recursively delete the key and everything below it. */ | > | | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 | return TCL_ERROR; } /* * Now we recursively delete the key and everything below it. */ Tcl_DStringInit(&buf); nativeTail = Tcl_UtfToWCharDString(tail, -1, &buf); result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); |
︙ | ︙ | |||
520 521 522 523 524 525 526 | mode |= KEY_SET_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetString(valueNameObj); | > | | | 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | mode |= KEY_SET_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetString(valueNameObj); Tcl_DStringInit(&ds); Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); result = RegDeleteValue(key, (const WCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to delete value \"%s\" from key \"%s\": ", Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; |
︙ | ︙ | |||
564 565 566 567 568 569 570 | Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ Tcl_Obj *patternObj, /* Optional match pattern. */ REGSAM mode) /* Mode flags to pass. */ { const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ | | | 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 | Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ Tcl_Obj *patternObj, /* Optional match pattern. */ REGSAM mode) /* Mode flags to pass. */ { const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ WCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ Tcl_Obj *resultPtr; /* List of subkeys being accumulated */ int result = TCL_OK; /* Return value from this command */ Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */ |
︙ | ︙ | |||
609 610 611 612 613 614 615 | "unable to enumerate subkeys of \"%s\": ", Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } break; } | > | | 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 | "unable to enumerate subkeys of \"%s\": ", Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } break; } Tcl_DStringInit(&ds); name = Tcl_WCharToUtfDString(buffer, bufSize, &ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); continue; } result = Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); |
︙ | ︙ | |||
659 660 661 662 663 664 665 | Tcl_Obj *valueNameObj, /* Name of value to get. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; DWORD result, type; Tcl_DString ds; const char *valueName; | | > | | 677 678 679 680 681 682 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 | Tcl_Obj *valueNameObj, /* Name of value to get. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; DWORD result, type; Tcl_DString ds; const char *valueName; const WCHAR *nativeValue; /* * Attempt to open the key for reading. */ mode |= KEY_QUERY_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } /* * Get the type of the value. */ valueName = Tcl_GetString(valueNameObj); Tcl_DStringInit(&ds); nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); result = RegQueryValueEx(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); RegCloseKey(key); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( |
︙ | ︙ | |||
728 729 730 731 732 733 734 | Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to get. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; const char *valueName; | | | 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 | Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to get. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; const char *valueName; const WCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; /* * Attempt to open the key for reading. */ |
︙ | ︙ | |||
753 754 755 756 757 758 759 | * * This allows short values to be read from the registy in one call. * Longer values need a second call with an expanded DString. */ Tcl_DStringInit(&data); Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); | | > | | | | 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 | * * This allows short values to be read from the registy in one call. * Longer values need a second call with an expanded DString. */ Tcl_DStringInit(&data); Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1; valueName = Tcl_GetString(valueNameObj); Tcl_DStringInit(&buf); nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &buf); result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* * The Windows docs say that in this error case, we just need to * expand our buffer and request more data. Required for * HKEY_PERFORMANCE_DATA */ length = Tcl_DStringLength(&data) * (2 / sizeof(WCHAR)); Tcl_DStringSetLength(&data, (int) length * sizeof(WCHAR)); result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( |
︙ | ︙ | |||
805 806 807 808 809 810 811 | /* * Multistrings are stored as an array of null-terminated strings, * terminated by two null characters. Also do a bounds check in case * we get bogus data. */ while ((p < end) && *((WCHAR *) p) != 0) { | | > | < | > > | 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 | /* * Multistrings are stored as an array of null-terminated strings, * terminated by two null characters. Also do a bounds check in case * we get bogus data. */ while ((p < end) && *((WCHAR *) p) != 0) { WCHAR *wp = (WCHAR *) p; Tcl_DStringInit(&buf); Tcl_WCharToUtfDString(wp, wcslen(wp), &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); while (*wp++ != 0) {/* empty body */} p = (char *) wp; Tcl_DStringFree(&buf); } Tcl_SetObjResult(interp, resultPtr); } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { WCHAR *wp = (WCHAR *) Tcl_DStringValue(&data); Tcl_DStringInit(&buf); Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&data), wcslen(wp), &buf); Tcl_DStringResult(interp, &buf); } else { /* * Save binary data as a byte array. */ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj( |
︙ | ︙ | |||
876 877 878 879 880 881 882 | mode |= KEY_QUERY_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); | | | < < | > | 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 | mode |= KEY_QUERY_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); index = 0; result = TCL_OK; if (patternObj) { pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } /* * Enumerate the values under the given subkey until we get an error, * indicating the end of the list. Note that we need to reset size after * each iteration because RegEnumValue smashes the old value. */ size = MAX_KEY_LENGTH; while (RegEnumValue(key,index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { Tcl_DStringInit(&ds); Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds); name = Tcl_DStringValue(&ds); if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); if (result != TCL_OK) { Tcl_DStringFree(&ds); break; |
︙ | ︙ | |||
1004 1005 1006 1007 1008 1009 1010 | Tcl_DString buf; /* * Attempt to open the root key on a remote host if necessary. */ if (hostName) { | > | | > | | | | 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 | Tcl_DString buf; /* * Attempt to open the root key on a remote host if necessary. */ if (hostName) { Tcl_DStringInit(&buf); hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf); result = RegConnectRegistry((WCHAR *)hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { return result; } } /* * Now open the specified key with the requested permissions. Note that * this key must be closed by the caller. */ if (keyName) { Tcl_DStringInit(&buf); keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf); } if (flags & REG_CREATE) { DWORD create; result = RegCreateKeyEx(rootKey, (WCHAR *)keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* * Here we fudge it for this special root key. See MSDN for more info * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. */ *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { result = RegOpenKeyEx(rootKey, (WCHAR *)keyName, 0, mode, keyPtr); } if (keyName) { Tcl_DStringFree(&buf); } /* |
︙ | ︙ | |||
1155 1156 1157 1158 1159 1160 1161 | * *---------------------------------------------------------------------- */ static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ | | | | | | | | 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 | * *---------------------------------------------------------------------- */ static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ const WCHAR *keyName, /* Name of key to be deleted in external * encoding, not UTF. */ REGSAM mode) /* Mode flags to pass. */ { DWORD result, size; Tcl_DString subkey; HKEY hKey; REGSAM saveMode = mode; static int checkExProc = 0; static LSTATUS (* regDeleteKeyExProc) (HKEY, LPCWSTR, REGSAM, DWORD) = (LSTATUS (*) (HKEY, LPCWSTR, REGSAM, DWORD)) NULL; /* * Do not allow NULL or empty key name. */ if (!keyName || *keyName == '\0') { return ERROR_BADKEY; } mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ size = MAX_KEY_LENGTH; result = RegEnumKeyEx(hKey, 0, (WCHAR *)Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { /* * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we * can't compile with it in. We need to check for it at runtime * and use it if we find it. */ if (mode && !checkExProc) { HMODULE handle; checkExProc = 1; handle = GetModuleHandle(TEXT("ADVAPI32")); regDeleteKeyExProc = (LSTATUS (*) (HKEY, LPCWSTR, REGSAM, DWORD)) GetProcAddress(handle, "RegDeleteKeyExW"); } if (mode && regDeleteKeyExProc) { result = regDeleteKeyExProc(startKey, keyName, mode, 0); } else { result = RegDeleteKey(startKey, keyName); } break; } else if (result == ERROR_SUCCESS) { result = RecursiveDeleteKey(hKey, (const WCHAR *) Tcl_DStringValue(&subkey), mode); } } Tcl_DStringFree(&subkey); RegCloseKey(hKey); return result; } |
︙ | ︙ | |||
1271 1272 1273 1274 1275 1276 1277 | } mode |= KEY_ALL_ACCESS; if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetString(valueNameObj); | > | | | 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 | } mode |= KEY_ALL_ACCESS; if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetString(valueNameObj); Tcl_DStringInit(&nameBuf); valueName = (char *) Tcl_UtfToWCharDString(valueName, valueNameObj->length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) { RegCloseKey(key); Tcl_DStringFree(&nameBuf); return TCL_ERROR; } value = ConvertDWORD((DWORD) type, (DWORD) value); result = RegSetValueEx(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; int objc, i; Tcl_Obj **objv; if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) { |
︙ | ︙ | |||
1315 1316 1317 1318 1319 1320 1321 | /* * Add a null character to separate this value from the next. */ Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } | > | | > | | | | 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 | /* * Add a null character to separate this value from the next. */ Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } Tcl_DStringInit(&buf); Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); result = RegSetValueEx(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; const char *data = Tcl_GetString(dataObj); Tcl_DStringInit(&buf); data = (char *) Tcl_UtfToWCharDString(data, dataObj->length, &buf); /* * Include the null in the length, padding if needed for WCHAR. */ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); result = RegSetValueEx(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); } else { BYTE *data; size_t bytelength; /* * Store binary data in the registry. */ data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength); result = RegSetValueEx(key, (WCHAR *) valueName, 0, (DWORD) type, data, (DWORD) bytelength); } Tcl_DStringFree(&nameBuf); RegCloseKey(key); if (result != ERROR_SUCCESS) { |
︙ | ︙ | |||
1406 1407 1408 1409 1410 1411 1412 | } if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) { return TCL_ERROR; } } str = Tcl_GetString(objv[0]); | > | | 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 | } if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) { return TCL_ERROR; } } str = Tcl_GetString(objv[0]); Tcl_DStringInit(&ds); wstr = Tcl_UtfToWCharDString(str, objv[0]->length, &ds); if (Tcl_DStringLength(&ds) == 0) { wstr = NULL; } /* * Use the ignore the result. */ |
︙ | ︙ | |||
1450 1451 1452 1453 1454 1455 1456 | static void AppendSystemError( Tcl_Interp *interp, /* Current interpreter. */ DWORD error) /* Result code from error. */ { int length; | | | > | | 1477 1478 1479 1480 1481 1482 1483 1484 1485 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 | static void AppendSystemError( Tcl_Interp *interp, /* Current interpreter. */ DWORD error) /* Result code from error. */ { int length; WCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr, 0, NULL); if (length == 0) { sprintf(msgBuf, "unknown error: %ld", error); msg = msgBuf; } else { char *msgPtr; Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &ds); LocalFree(tMsgPtr); msgPtr = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. |
︙ | ︙ |
Changes to win/tclWinSerial.c.
︙ | ︙ | |||
1665 1666 1667 1668 1669 1670 1671 | * Option -mode baud,parity,databits,stopbits */ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { goto getStateFailed; } | > | | 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 | * Option -mode baud,parity,databits,stopbits */ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { goto getStateFailed; } Tcl_DStringInit(&ds); native = Tcl_UtfToWCharDString(value, -1, &ds); result = BuildCommDCB(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -mode: should be baud,parity,data,stop", |
︙ | ︙ |
Changes to win/tclWinSock.c.
︙ | ︙ | |||
363 364 365 366 367 368 369 370 371 372 373 374 | unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { WCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; DWORD length = MAX_COMPUTERNAME_LENGTH + 1; Tcl_DString ds; if (GetComputerName(tbuf, &length) != 0) { /* * Convert string from native to UTF then change to lowercase. */ | > | < | 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 | unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { WCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; DWORD length = MAX_COMPUTERNAME_LENGTH + 1; Tcl_DString ds; Tcl_DStringInit(&ds); if (GetComputerName(tbuf, &length) != 0) { /* * Convert string from native to UTF then change to lowercase. */ Tcl_UtfToLower(Tcl_WCharToUtfDString(tbuf, -1, &ds)); } else { if (TclpHasSockets(NULL) == TCL_OK) { /* * The buffer size of 256 is recommended by the MSDN page that * documents gethostname() as being always adequate. */ Tcl_DString inDs; |
︙ | ︙ |
Changes to win/tclWinTest.c.
︙ | ︙ | |||
37 38 39 40 41 42 43 44 45 46 47 48 49 50 | static int TestvolumetypeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); static int TestchmodCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- | > > | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | static int TestvolumetypeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static int TestSizeCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); static int TestchmodCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
74 75 76 77 78 79 80 81 82 83 84 85 86 87 | Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TesteventloopCmd -- | > | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TesteventloopCmd -- |
︙ | ︙ | |||
305 306 307 308 309 310 311 312 313 314 315 316 317 318 | } if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { return TCL_ERROR; } Sleep((DWORD) ms); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestExceptionCmd -- * * Causes this process to end with the named exception. Used for testing | > > > > > > > > > > > > > > > > > > > > > > > > > | 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 | } if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { return TCL_ERROR; } Sleep((DWORD) ms); return TCL_OK; } static int TestSizeCmd( ClientData clientData, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { if (objc != 2) { goto syntax; } if (strcmp(Tcl_GetString(objv[1]), "time_t") == 0) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(time_t))); return TCL_OK; } if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) { Tcl_StatBuf *statPtr; Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); return TCL_OK; } syntax: Tcl_WrongNumArgs(interp, 1, objv, "time_t|st_mtime"); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TestExceptionCmd -- * * Causes this process to end with the named exception. Used for testing |
︙ | ︙ |
Changes to win/tclWinTime.c.
︙ | ︙ | |||
120 121 122 123 124 125 126 | * Scale to convert wide click values from the TclpGetWideClicks native * resolution to microsecond resolution and back. */ static struct { int initialized; /* 1 if initialized, 0 otherwise */ int perfCounter; /* 1 if performance counter usable for wide clicks */ double microsecsScale; /* Denominator scale between clock / microsecs */ | | | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | * Scale to convert wide click values from the TclpGetWideClicks native * resolution to microsecond resolution and back. */ static struct { int initialized; /* 1 if initialized, 0 otherwise */ int perfCounter; /* 1 if performance counter usable for wide clicks */ double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; /* * Declarations for functions defined later in this file. */ #ifndef TCL_NO_DEPRECATED |
︙ | ︙ | |||
194 195 196 197 198 199 200 | *---------------------------------------------------------------------- * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no guarantees on what the * resolution will be. In Tcl we will call this value a "click". The | | | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | *---------------------------------------------------------------------- * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no guarantees on what the * resolution will be. In Tcl we will call this value a "click". The * start time is also system dependent. * * Results: * Number of clicks from some start time. * * Side effects: * None. * |
︙ | ︙ | |||
730 731 732 733 734 735 736 737 738 739 740 741 742 743 | struct tm * TclpGetDate( const time_t *t, int useGMT) { struct tm *tmPtr; time_t time; if (!useGMT) { #if defined(_MSC_VER) && (_MSC_VER >= 1900) # undef timezone /* prevent conflict with timezone() function */ long timezone = 0; #endif | > > > > > | 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 | struct tm * TclpGetDate( const time_t *t, int useGMT) { struct tm *tmPtr; time_t time; #if defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)) # define t2 *t /* no need to cripple time to 32-bit */ #else time_t t2 = *(__time32_t *)t; #endif if (!useGMT) { #if defined(_MSC_VER) && (_MSC_VER >= 1900) # undef timezone /* prevent conflict with timezone() function */ long timezone = 0; #endif |
︙ | ︙ | |||
762 763 764 765 766 767 768 | #ifdef __BORLANDC__ #define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY #else #define LOCALTIME_VALIDITY_BOUNDARY 0 #endif | | | | | | | 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 | #ifdef __BORLANDC__ #define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY #else #define LOCALTIME_VALIDITY_BOUNDARY 0 #endif if (t2 >= LOCALTIME_VALIDITY_BOUNDARY) { return TclpLocaltime(&t2); } #if defined(_MSC_VER) && (_MSC_VER >= 1900) _get_timezone(&timezone); #endif time = t2 - timezone; /* * If we aren't near to overflowing the long, just add the bias and * use the normal calculation. Otherwise we will need to adjust the * result at the end. */ if (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) { tmPtr = ComputeGMT(&time); } else { tmPtr = ComputeGMT(&t2); tzset(); /* * Add the bias directly to the tm structure to avoid overflow. * Propagate seconds overflow into minutes, hours and days. */ |
︙ | ︙ | |||
817 818 819 820 821 822 823 | time /= 24; tmPtr->tm_mday += (int)time; tmPtr->tm_yday += (int)time; tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; } } else { | | | 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 | time /= 24; tmPtr->tm_mday += (int)time; tmPtr->tm_yday += (int)time; tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; } } else { tmPtr = ComputeGMT(&t2); } return tmPtr; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 | { /* * The MS implementation of gmtime is thread safe because it returns the * time in a block of thread-local storage, and Windows does not provide a * Posix gmtime_r function. */ return gmtime(timePtr); } /* *---------------------------------------------------------------------- * * TclpLocaltime -- * | > > > > | 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 | { /* * The MS implementation of gmtime is thread safe because it returns the * time in a block of thread-local storage, and Windows does not provide a * Posix gmtime_r function. */ #if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) return gmtime(timePtr); #else return _gmtime32((CONST __time32_t *)timePtr); #endif } /* *---------------------------------------------------------------------- * * TclpLocaltime -- * |
︙ | ︙ | |||
1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 | { /* * The MS implementation of localtime is thread safe because it returns * the time in a block of thread-local storage, and Windows does not * provide a Posix localtime_r function. */ return localtime(timePtr); } #endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_SetTimeProc -- | > > > > | 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 | { /* * The MS implementation of localtime is thread safe because it returns * the time in a block of thread-local storage, and Windows does not * provide a Posix localtime_r function. */ #if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) return localtime(timePtr); #else return _localtime32((CONST __time32_t *)timePtr); #endif } #endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_SetTimeProc -- |
︙ | ︙ |