diff options
75 files changed, 1062 insertions, 689 deletions
diff --git a/.gitattributes b/.gitattributes new file mode 100755 index 0000000..82bed50 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,37 @@ +# Set the default behavior, in case people don't have core.autocrlf set. +* text eol=lf + +# 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 text eol=crlf +*.sln text eol=crlf +*.vc text eol=crlf + +# Denote all files that are truly binary and should not be modified. +*.a binary +*.dll binary +*.exe binary +*.gif binary +*.jpg binary +*.lib binary +*.pdf binary +*.png binary +*.xlsx binary +*.zip binary diff --git a/.gitignore b/.gitignore new file mode 100755 index 0000000..99fd07e --- /dev/null +++ b/.gitignore @@ -0,0 +1,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 diff --git a/.travis.yml b/.travis.yml index 92296c1..73e3fc2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,54 +3,62 @@ language: c matrix: include: - - name: "Linux/Clang/Shared" +# Testing on Linux with various compilers + - name: "Linux/GCC/Shared" os: linux dist: xenial - compiler: clang + compiler: gcc env: - BUILD_DIR=unix - - name: "Linux/Clang/Static" + - name: "Linux/GCC/Static" os: linux dist: xenial - compiler: clang + compiler: gcc env: - CFGOPT=--disable-shared - BUILD_DIR=unix - - name: "Linux/GCC/Shared" + - name: "Linux/GCC/Shared: UTF_MAX=6" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - - name: "Linux/GCC/Static" + - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 + - name: "Linux/GCC/Shared: UTF_MAX=3" os: linux dist: xenial compiler: gcc env: - - CFGOPT=--disable-shared - BUILD_DIR=unix - - name: "Linux/GCC 4.9/Shared" + - CFGOPT=CFLAGS=-DTCL_UTF_MAX=3 + - name: "Linux/GCC/Shared: NO_DEPRECATED" os: linux dist: xenial - compiler: gcc-4.9 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-4.9 + compiler: gcc env: - BUILD_DIR=unix - - name: "Linux/GCC 5/Shared" + - 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-5 + 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++-5 + - g++-7 env: - BUILD_DIR=unix - name: "Linux/GCC 6/Shared" @@ -65,91 +73,98 @@ matrix: - g++-6 env: - BUILD_DIR=unix - - name: "Linux/GCC 7/Shared" + - name: "Linux/GCC 5/Shared" os: linux dist: xenial - compiler: gcc-7 + compiler: gcc-5 addons: apt: sources: - ubuntu-toolchain-r-test packages: - - g++-7 + - g++-5 env: - BUILD_DIR=unix - - name: "Linux/GCC 7/Shared/UTF_MAX=6" + - name: "Linux/GCC 4.9/Shared" os: linux dist: xenial - compiler: gcc-7 + compiler: gcc-4.9 addons: apt: sources: - ubuntu-toolchain-r-test packages: - - g++-7 + - g++-4.9 env: - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 - - name: "Linux/GCC 7/Shared/UTF_MAX=3" +# Clang + - name: "Linux/Clang/Shared" os: linux dist: xenial - compiler: gcc-7 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-7 + compiler: clang env: - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=3 - - name: "Linux/GCC 7/Shared/NO_DEPRECATED" + - name: "Linux/Clang/Static" os: linux dist: xenial - compiler: gcc-7 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-7 + compiler: clang env: + - CFGOPT=--disable-shared - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_NO_DEPRECATED=1 - - name: "macOS/Xcode 8/Shared/Unix-like" +# 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: xcode8 + osx_image: xcode11 env: - BUILD_DIR=unix - - name: "macOS/Xcode 8/Shared/Mac-like" + - name: "macOS/Xcode 11/Shared" os: osx - osx_image: xcode8 + 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 - - NO_DIRECT_CONFIGURE=1 - - name: "macOS/Xcode 9/Shared/Mac-like" + install: [] + script: *mactest + - name: "macOS/Xcode 9/Shared" os: osx osx_image: xcode9 env: - BUILD_DIR=macosx - - NO_DIRECT_CONFIGURE=1 - - name: "macOS/Xcode 10/Shared/Mac-like" + install: [] + script: *mactest + - name: "macOS/Xcode 8/Shared" os: osx - osx_image: xcode10.2 + osx_image: xcode8 env: - BUILD_DIR=macosx - - NO_DIRECT_CONFIGURE=1 -### C builds not currently supported on Windows instances -# - os: windows -# env: -# - BUILD_DIR=win -### ... so proxy with a Mingw cross-compile -# Test with mingw-w64 (32 bit) + install: [] + script: *mactest +# 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: + addons: &mingw32 apt: packages: - gcc-mingw-w64-base @@ -161,81 +176,63 @@ matrix: env: - BUILD_DIR=win - CFGOPT=--host=i686-w64-mingw32 - - NO_DIRECT_TEST=1 + 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-32/GCC/Static/no test" os: linux dist: xenial compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine + addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 --disable-shared" - - NO_DIRECT_TEST=1 - - name: "Linux-cross-Windows-32/GCC/Shared/no test/UTF_MAX=6" + script: *crosstest + - name: "Linux-cross-Windows-32/GCC/Shared/no test: UTF_MAX=6" os: linux dist: xenial compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine + addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6" - - NO_DIRECT_TEST=1 - - name: "Linux-cross-Windows-32/GCC/Shared/no test/UTF_MAX=3" + script: *crosstest + - name: "Linux-cross-Windows-32/GCC/Shared/no test: UTF_MAX=3" os: linux dist: xenial compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine + addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=3" - - NO_DIRECT_TEST=1 - - name: "Linux-cross-Windows-32/GCC/Shared/no test/NO_DEPRECATED" + script: *crosstest + - name: "Linux-cross-Windows-32/GCC/Shared/no test: NO_DEPRECATED" os: linux dist: xenial compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine + addons: *mingw32 env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_NO_DEPRECATED=1" - - NO_DIRECT_TEST=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 with mingw-w64 (64 bit) +# Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows-64/GCC/Shared/no test" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc - addons: + addons: &mingw64 apt: packages: - gcc-mingw-w64-base @@ -246,77 +243,108 @@ matrix: env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" - - NO_DIRECT_TEST=1 + script: *crosstest - name: "Linux-cross-Windows-64/GCC/Static/no test" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine + addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared" - - NO_DIRECT_TEST=1 - - name: "Linux-cross-Windows-64/GCC/Shared/no test/UTF_MAX=6" + script: *crosstest + - name: "Linux-cross-Windows-64/GCC/Shared/no test: UTF_MAX=6" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine + addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6" - - NO_DIRECT_TEST=1 - - name: "Linux-cross-Windows-64/GCC/Shared/no test/UTF_MAX=3" + script: *crosstest + - name: "Linux-cross-Windows-64/GCC/Shared/no test: UTF_MAX=3" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine + addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=3" - - NO_DIRECT_TEST=1 - - name: "Linux-cross-Windows-64/GCC/Shared/no test/NO_DEPRECATED" + script: *crosstest + - name: "Linux-cross-Windows-64/GCC/Shared/no test: NO_DEPRECATED" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine + addons: *mingw64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" - - NO_DIRECT_TEST=1 + script: *crosstest + - name: "Linux-cross-Windows-64/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 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' before_install: - - export ERROR_ON_FAILURES=1 - cd ${BUILD_DIR} install: - - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT} + - ./configure ${CFGOPT} --prefix=$HOME +before_script: + - export ERROR_ON_FAILURES=1 script: - - make - # The styles=develop avoids some weird problems on OSX - - test -n "$NO_DIRECT_TEST" || make test styles=develop + - make all tcltest + - make test diff --git a/compat/stdlib.h b/compat/stdlib.h index 6900be3..bb0f133 100644 --- a/compat/stdlib.h +++ b/compat/stdlib.h @@ -5,7 +5,7 @@ * 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 strtod). + * 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. diff --git a/doc/Notifier.3 b/doc/Notifier.3 index 16f9f8d..ec9f910 100644 --- a/doc/Notifier.3 +++ b/doc/Notifier.3 @@ -132,22 +132,17 @@ higher-level software that they have occurred. The procedures and \fBTcl_SetMaxBlockTime\fR, \fBTcl_QueueEvent\fR, and \fBTcl_DeleteEvents\fR are used primarily by event sources. .IP [2] -The event queue: for non-threaded applications, -there is a single queue for the whole application, -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. Threaded applications work in a -similar manner, except that there is a separate event queue for -each thread containing a Tcl interpreter. +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 event queue and +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. In a threaded application, \fBTcl_QueueEvent\fR adds -an event to the current thread's queue, and \fBTcl_ThreadQueueEvent\fR -adds an event to a queue in a specific thread. +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 @@ -403,11 +398,7 @@ 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 -Threaded applications work in a -similar manner, except that there is a separate event queue for -each thread containing a Tcl interpreter. -Calling \fBTcl_QueueEvent\fR in a multithreaded application adds -an event to the current thread's queue. +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 @@ -498,8 +489,7 @@ 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 in multithreaded applications to allow -any thread to +\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 @@ -22,7 +22,7 @@ home directory (as specified in the HOME environment variable) if 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 (in a threaded environment) all threads. +and all threads. .SH EXAMPLES .PP Change to the home directory of the user \fBfred\fR: diff --git a/generic/regcustom.h b/generic/regcustom.h index 095385d..4396399 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -131,7 +131,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */ #if 1 #define AllocVars(vPtr) \ static Tcl_ThreadDataKey varsKey; \ - register struct vars *vPtr = (struct vars *) \ + struct vars *vPtr = (struct vars *) \ Tcl_GetThreadData(&varsKey, sizeof(struct vars)) #else /* @@ -140,7 +140,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */ * faster in practice (measured!) */ #define AllocVars(vPtr) \ - register struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) + struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) #define FreeVars(vPtr) \ FREE(vPtr) #endif diff --git a/generic/regguts.h b/generic/regguts.h index b3dbaa4..da38ef2 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -411,7 +411,7 @@ struct guts { #ifndef AllocVars #define AllocVars(vPtr) \ struct vars var; \ - register struct vars *vPtr = &var + struct vars *vPtr = &var #endif #ifndef FreeVars #define FreeVars(vPtr) ((void) 0) diff --git a/generic/tcl.h b/generic/tcl.h index cd194d1..f3253db 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -406,7 +406,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; #if defined(_WIN32) # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; -# elif defined(_WIN64) +# elif defined(_WIN64) || defined(__MINGW_USE_VC2005_COMPAT) || 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; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e2025f6..732e625 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -453,24 +453,24 @@ typedef struct { const char *name; /* Name of the function. The full name is * "::tcl::mathfunc::<name>". */ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */ - void *clientData; /* Client data for the function */ + double (*fn)(double x); /* Real function pointer */ } BuiltinFuncDef; static const BuiltinFuncDef BuiltinFuncTable[] = { { "abs", ExprAbsFunc, NULL }, - { "acos", ExprUnaryFunc, (void *) acos }, - { "asin", ExprUnaryFunc, (void *) asin }, - { "atan", ExprUnaryFunc, (void *) atan }, - { "atan2", ExprBinaryFunc, (void *) atan2 }, + { "acos", ExprUnaryFunc, acos }, + { "asin", ExprUnaryFunc, asin }, + { "atan", ExprUnaryFunc, atan }, + { "atan2", ExprBinaryFunc, (double (*)(double)) (double (*)(double, double)) atan2}, { "bool", ExprBoolFunc, NULL }, { "ceil", ExprCeilFunc, NULL }, - { "cos", ExprUnaryFunc, (void *) cos }, - { "cosh", ExprUnaryFunc, (void *) cosh }, + { "cos", ExprUnaryFunc, cos }, + { "cosh", ExprUnaryFunc, cosh }, { "double", ExprDoubleFunc, NULL }, { "entier", ExprIntFunc, NULL }, - { "exp", ExprUnaryFunc, (void *) exp }, + { "exp", ExprUnaryFunc, exp }, { "floor", ExprFloorFunc, NULL }, - { "fmod", ExprBinaryFunc, (void *) fmod }, - { "hypot", ExprBinaryFunc, (void *) hypot }, + { "fmod", ExprBinaryFunc, (double (*)(double)) (double (*)(double, double)) fmod}, + { "hypot", ExprBinaryFunc, (double (*)(double)) (double (*)(double, double)) hypot}, { "int", ExprIntFunc, NULL }, { "isfinite", ExprIsFiniteFunc, NULL }, { "isinf", ExprIsInfinityFunc, NULL }, @@ -479,19 +479,19 @@ static const BuiltinFuncDef BuiltinFuncTable[] = { { "isqrt", ExprIsqrtFunc, NULL }, { "issubnormal", ExprIsSubnormalFunc, NULL, }, { "isunordered", ExprIsUnorderedFunc, NULL, }, - { "log", ExprUnaryFunc, (void *) log }, - { "log10", ExprUnaryFunc, (void *) log10 }, + { "log", ExprUnaryFunc, log }, + { "log10", ExprUnaryFunc, log10 }, { "max", ExprMaxFunc, NULL }, { "min", ExprMinFunc, NULL }, - { "pow", ExprBinaryFunc, (void *) pow }, + { "pow", ExprBinaryFunc, (double (*)(double)) (double (*)(double, double)) pow}, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, - { "sin", ExprUnaryFunc, (void *) sin }, - { "sinh", ExprUnaryFunc, (void *) sinh }, + { "sin", ExprUnaryFunc, sin }, + { "sinh", ExprUnaryFunc, sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, - { "tan", ExprUnaryFunc, (void *) tan }, - { "tanh", ExprUnaryFunc, (void *) tanh }, + { "tan", ExprUnaryFunc, tan }, + { "tanh", ExprUnaryFunc, tanh }, { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } }; @@ -657,7 +657,15 @@ Tcl_CreateInterp(void) Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } -#if defined(_WIN32) && !defined(_WIN64) +#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) \ + && !defined(__MINGW_USE_VC2005_COMPAT) + /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T or + * -D__MINGW_USE_VC2005_COMPAT, the result is a binary incompatible + * with the 'standard' build of Tcl: All extensions using Tcl_StatBuf + * or interal functions like TclpGetDate() 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 (sizeof(time_t) != 4) { /*NOTREACHED*/ Tcl_Panic("<time.h> is not compatible with MSVC"); @@ -1078,7 +1086,7 @@ Tcl_CreateInterp(void) builtinFuncPtr++) { strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, - builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL); + builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); } @@ -2635,7 +2643,7 @@ TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace * components. */ - Tcl_Namespace *ns, /* The namespace to create the command in */ + 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 @@ -2649,7 +2657,7 @@ TclCreateObjCommandInNs( ImportRef *oldRefPtr = NULL; ImportedCmdData *dataPtr; Tcl_HashEntry *hPtr; - Namespace *nsPtr = (Namespace *) ns; + Namespace *nsPtr = (Namespace *) namesp; /* * If the command name we seek to create already exists, we need to delete diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 0a5b745..3b4dfc8 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4188,7 +4188,6 @@ Tcl_TimeRateObjCmd( }; NRE_callback *rootPtr; ByteCode *codePtr = NULL; - int codeOptimized = 0; for (i = 1; i < objc - 1; i++) { int index; @@ -4373,15 +4372,6 @@ Tcl_TimeRateObjCmd( } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); - /* - * Replace last compiled done instruction with continue: 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.) - */ - if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) { - codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE; - codeOptimized = 1; - } } /* @@ -4423,6 +4413,12 @@ Tcl_TimeRateObjCmd( 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 */ @@ -4675,11 +4671,6 @@ Tcl_TimeRateObjCmd( done: if (codePtr != NULL) { - if ( codeOptimized - && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE - ) { - codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE; - } TclReleaseByteCode(codePtr); } return result; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 6aa9705..56a98aa 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -3174,7 +3174,7 @@ TclCompileFormatCmd( DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Obj **objv, *formatObj, *tmpObj; - char *bytes, *start; + const char *bytes, *start; int i, j, len; /* @@ -3301,7 +3301,7 @@ TclCompileFormatCmd( if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { - char *b = TclGetStringFromObj(tmpObj, &len); + const char *b = TclGetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 43c4299..c282849 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -589,7 +589,7 @@ TclCompileInfoCommandsCmd( DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; - char *bytes; + const char *bytes; /* * We require one compile-time known argument for the case we can compile. diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index ea7ee09..ad47f66 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -925,7 +925,7 @@ TclCompileStringMapCmd( DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; - char *bytes; + const char *bytes; int len; /* diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 6b30f8b..5e39a21 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1217,7 +1217,7 @@ 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, - register Tcl_Interp *interp, int objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); @@ -1405,7 +1405,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, #define TclEmitPush(objIndex, envPtr) \ do { \ - register int _objIndexCopy = (objIndex); \ + int _objIndexCopy = (objIndex); \ if (_objIndexCopy <= 255) { \ TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ } else { \ diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d index 360bdff..f5493b1 100644 --- a/generic/tclDTrace.d +++ b/generic/tclDTrace.d @@ -10,7 +10,6 @@ */ typedef struct Tcl_Obj Tcl_Obj; -typedef const char* TclDTraceStr; /* * Tcl DTrace probes @@ -25,14 +24,14 @@ provider tcl { * arg1: number of arguments (int) * arg2: array of proc argument objects (Tcl_Obj**) */ - probe proc__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv); + 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(TclDTraceStr name, int code); + probe proc__return(const char *name, int code); /* * tcl*:::proc-result probe * triggered after proc-return probe and result processing @@ -41,7 +40,7 @@ provider tcl { * arg2: proc result (string) * arg3: proc result object (Tcl_Obj*) */ - probe proc__result(TclDTraceStr name, int code, TclDTraceStr result, + probe proc__result(const char *name, int code, const char *result, struct Tcl_Obj *resultobj); /* * tcl*:::proc-args probe @@ -50,10 +49,10 @@ provider tcl { * arg0: proc name (string) * arg1-arg9: proc arguments or NULL (strings) */ - probe proc__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2, - TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5, - TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8, - TclDTraceStr arg9); + 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 @@ -67,9 +66,9 @@ provider tcl { * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ - probe proc__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc, - TclDTraceStr file, int line, int level, TclDTraceStr method, - TclDTraceStr class); + 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 ******************************/ /* @@ -79,14 +78,14 @@ provider tcl { * arg1: number of arguments (int) * arg2: array of command argument objects (Tcl_Obj**) */ - probe cmd__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv); + 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(TclDTraceStr name, int code); + probe cmd__return(const char *name, int code); /* * tcl*:::cmd-result probe * triggered after cmd-return probe and result processing @@ -95,7 +94,7 @@ provider tcl { * arg2: command result (string) * arg3: command result object (Tcl_Obj*) */ - probe cmd__result(TclDTraceStr name, int code, TclDTraceStr result, + probe cmd__result(const char *name, int code, const char *result, struct Tcl_Obj *resultobj); /* * tcl*:::cmd-args probe @@ -104,10 +103,10 @@ provider tcl { * arg0: command name (string) * arg1-arg9: command arguments or NULL (strings) */ - probe cmd__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2, - TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5, - TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8, - TclDTraceStr arg9); + 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 @@ -121,9 +120,9 @@ provider tcl { * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ - probe cmd__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc, - TclDTraceStr file, int line, int level, TclDTraceStr method, - TclDTraceStr class); + 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 *****************************/ /* @@ -133,7 +132,7 @@ provider tcl { * arg1: depth of stack (int) * arg2: top of stack (Tcl_Obj**) */ - probe inst__start(TclDTraceStr name, int depth, struct Tcl_Obj **stack); + probe inst__start(const char *name, int depth, struct Tcl_Obj **stack); /* * tcl*:::inst-done probe * triggered immediately after execution of a bytecode @@ -141,7 +140,7 @@ provider tcl { * arg1: depth of stack (int) * arg2: top of stack (Tcl_Obj**) */ - probe inst__done(TclDTraceStr name, int depth, struct Tcl_Obj **stack); + probe inst__done(const char *name, int depth, struct Tcl_Obj **stack); /***************************** obj probes ******************************/ /* @@ -163,10 +162,10 @@ provider tcl { * triggered when the ::tcl::dtrace command is called * arg0-arg9: command arguments (strings) */ - probe tcl__probe(TclDTraceStr arg0, TclDTraceStr arg1, TclDTraceStr arg2, - TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5, - TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8, - TclDTraceStr arg9); + 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); }; /* @@ -174,7 +173,7 @@ provider tcl { */ typedef struct Tcl_ObjType { - char *name; + const char *name; void *freeIntRepProc; void *dupIntRepProc; void *updateStringProc; @@ -185,7 +184,7 @@ struct Tcl_Obj { int refCount; char *bytes; int length; - Tcl_ObjType *typePtr; + const Tcl_ObjType *typePtr; union { long longValue; double doubleValue; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 3e288c5..761d879 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2580,7 +2580,7 @@ BuildEnsembleConfig( if (subList) { int subc; Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; - char *name; + const char *name; /* * There is a list of exactly what subcommands go in the table. @@ -2665,7 +2665,7 @@ BuildEnsembleConfig( Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, &keyObj, &valueObj, &done); while (!done) { - char *name = TclGetString(keyObj); + const char *name = TclGetString(keyObj); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); Tcl_SetHashValue(hPtr, valueObj); @@ -3379,7 +3379,7 @@ CompileToInvokedCommand( { Tcl_Token *tokPtr; Tcl_Obj *objPtr, **words; - char *bytes; + const char *bytes; int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME; DefineLineInformation; diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 865a330..5e840e9 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -454,18 +454,18 @@ TclUnsetEnv( */ #if defined(_WIN32) - string = ckalloc(length + 2); + string = (char *)ckalloc(length + 2); memcpy(string, name, length); string[length] = '='; string[length+1] = '\0'; #else - string = ckalloc(length + 1); + string = (char *)ckalloc(length + 1); memcpy(string, name, length); string[length] = '\0'; #endif /* _WIN32 */ Tcl_UtfToExternalDString(NULL, string, -1, &envString); - string = ckrealloc(string, Tcl_DStringLength(&envString) + 1); + string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + 1); memcpy(string, Tcl_DStringValue(&envString), Tcl_DStringLength(&envString)+1); Tcl_DStringFree(&envString); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f977ce8..f085c57 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1981,7 +1981,14 @@ TclNRExecuteByteCode( */ TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL, - /* cleanup */ INT2PTR(0), 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; } @@ -2043,6 +2050,7 @@ TEBCresume( #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. @@ -2526,6 +2534,14 @@ TEBCresume( 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 @@ -7695,7 +7711,7 @@ TEBCresume( */ /* - * Abnormal return code. Restore the stack to state it had when + * 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. */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index c0c1d24..e7efc8e 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -86,16 +86,6 @@ static void Disclaim(void); static void * DivertFindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); static void DivertUnloadFile(Tcl_LoadHandle loadHandle); - -/* - * These form part of the native filesystem support. They are needed here - * because we have a few native filesystem functions (which are the same for - * win/unix) in this file. There is no need to place them in tclInt.h, because - * they are not (and should not be) used anywhere else. - */ - -MODULE_SCOPE const char *const tclpFileAttrStrings[]; -MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; /* * Declare the native filesystem support. These functions should be considered @@ -1392,7 +1382,7 @@ TclFSNormalizeToUniquePath( int i; int isVfsPath = 0; - char *path; + const char *path; /* * Paths starting with a UNC prefix whose final character is a colon diff --git a/generic/tclInt.h b/generic/tclInt.h index 057627b..0d1f137 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2259,6 +2259,7 @@ typedef struct Interp { #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: @@ -4234,7 +4235,6 @@ MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); #ifdef USE_DTRACE #ifndef _TCLDTRACE_H -typedef const char *TclDTraceStr; #include "tclDTrace.h" #endif #define TCL_DTRACE_OBJ_CREATE(objPtr) TCL_OBJ_CREATE(objPtr) @@ -4512,6 +4512,21 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, } /* + * These form part of the native filesystem support. They are needed here + * because we have a few native filesystem functions (which are the same for + * win/unix) in this file. + */ + +#ifdef __cplusplus +extern "C" { +#endif +MODULE_SCOPE const char *const tclpFileAttrStrings[]; +MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; +#ifdef __cplusplus +} +#endif + +/* *---------------------------------------------------------------- * Macro used by the Tcl core to test whether an object has a * string representation (or is a 'pure' internal value). @@ -4535,8 +4550,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclUnpackBignum(objPtr, bignum) \ do { \ - register Tcl_Obj *bignumObj = (objPtr); \ - register int bignumPayload = \ + Tcl_Obj *bignumObj = (objPtr); \ + int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 345574b..f86eab6 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -209,7 +209,7 @@ TclCreateLiteral( */ int objLength; - char *objBytes = TclGetStringFromObj(objPtr, &objLength); + const char *objBytes = TclGetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) || ((objBytes[0] == bytes[0]) diff --git a/generic/tclMain.c b/generic/tclMain.c index 5fe4f43..e547738 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -60,7 +60,7 @@ */ #if defined(UNICODE) && (TCL_UTF_MAX <= 4) -# define NewNativeObj Tcl_NewUnicodeObj +# define NewNativeObj(a,b) Tcl_NewUnicodeObj((const Tcl_UniChar *)a,b) #else /* !UNICODE || (TCL_UTF_MAX > 4) */ static inline Tcl_Obj * NewNativeObj( diff --git a/generic/tclObj.c b/generic/tclObj.c index 8e13e4f..7a31697 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3018,6 +3018,7 @@ Tcl_GetLongFromObj( * values in the unsigned long range will fit in a long. */ + { mp_int big; unsigned long scratch, value = 0, numBytes = sizeof(unsigned long); unsigned char *bytes = (unsigned char *) &scratch; @@ -3039,6 +3040,7 @@ Tcl_GetLongFromObj( } } } + } #ifndef TCL_WIDE_INT_IS_LONG tooLarge: #endif diff --git a/generic/tclPanic.c b/generic/tclPanic.c index e8c1e7f..1096ead 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -51,7 +51,7 @@ Tcl_SetPanicProc( { #if defined(_WIN32) /* tclWinDebugPanic only installs if there is no panicProc yet. */ - if ((proc != tclWinDebugPanic) || (panicProc == NULL)) + if (((Tcl_PanicProc *)proc != tclWinDebugPanic) || (panicProc == NULL)) #elif defined(__CYGWIN__) if (proc == NULL) panicProc = tclWinDebugPanic; diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 51659ee..34598d6 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -2242,7 +2242,7 @@ SetFsPathFromAny( int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; - char *name; + const char *name; if (TclHasIntRep(pathPtr, &fsPathType)) { return TCL_OK; diff --git a/generic/tclProc.c b/generic/tclProc.c index 1b344de..f0974bf 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -157,7 +157,7 @@ Tcl_ProcObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; Proc *procPtr; const char *procName; const char *simpleName, *procArgs, *procBody; @@ -761,7 +761,7 @@ TclObjGetFrame( CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; int curLevel, level, result; const Tcl_ObjIntRep *irPtr; const char *name = NULL; @@ -898,7 +898,7 @@ TclNRUplevelObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; int result; @@ -1038,7 +1038,7 @@ ProcWrongNumArgs( int skip) { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; - register Proc *procPtr = framePtr->procPtr; + Proc *procPtr = framePtr->procPtr; int localCt = procPtr->numCompiledLocals, numArgs, i; Tcl_Obj **desiredObjs; const char *final = NULL; @@ -1063,7 +1063,7 @@ ProcWrongNumArgs( Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { - register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); + Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); for (i=1 ; i<=numArgs ; i++, defPtr++) { Tcl_Obj *argObj; @@ -1254,7 +1254,7 @@ InitResolvedLocals( resVarInfo = localPtr->resolveInfo; if (resVarInfo && resVarInfo->fetchProc) { - register Var *resolvedVarPtr = (Var *) + Var *resolvedVarPtr = (Var *) resVarInfo->fetchProc(interp, resVarInfo); if (resolvedVarPtr) { @@ -1277,7 +1277,7 @@ TclFreeLocalCache( Tcl_Obj **namePtrPtr = &localCachePtr->varName0; for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) { - register Tcl_Obj *objPtr = *namePtrPtr; + Tcl_Obj *objPtr = *namePtrPtr; if (objPtr) { /* TclReleaseLiteral calls Tcl_DecrRefCount for us */ @@ -1363,16 +1363,16 @@ InitLocalCache( static int InitArgsAndLocals( - register Tcl_Interp *interp,/* Interpreter in which procedure was + 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; - register Proc *procPtr = framePtr->procPtr; + Proc *procPtr = framePtr->procPtr; ByteCode *codePtr; - register Var *varPtr, *defPtr; + Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; @@ -1530,7 +1530,7 @@ int TclPushProcCallFrame( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1622,7 +1622,7 @@ int TclObjInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1639,7 +1639,7 @@ int TclNRInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1674,7 +1674,7 @@ TclNRInterpProc( int TclNRInterpProcCore( - register Tcl_Interp *interp,/* Interpreter in which procedure was + 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, @@ -1683,7 +1683,7 @@ TclNRInterpProcCore( * results of the overall procedure. */ { Interp *iPtr = (Interp *) interp; - register Proc *procPtr = iPtr->varFramePtr->procPtr; + Proc *procPtr = iPtr->varFramePtr->procPtr; int result; CallFrame *freePtr; ByteCode *codePtr; @@ -1700,8 +1700,8 @@ TclNRInterpProcCore( #if defined(TCL_COMPILE_DEBUG) if (tclTraceExec >= 1) { - register CallFrame *framePtr = iPtr->varFramePtr; - register int i; + CallFrame *framePtr = iPtr->varFramePtr; + int i; if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { fprintf(stdout, "Calling lambda "); @@ -2119,9 +2119,9 @@ TclProcDeleteProc( void TclProcCleanupProc( - register Proc *procPtr) /* Procedure to be deleted. */ + Proc *procPtr) /* Procedure to be deleted. */ { - register CompiledLocal *localPtr; + CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; @@ -2370,7 +2370,7 @@ ProcBodyFree( static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; @@ -2385,7 +2385,7 @@ DupLambdaInternalRep( static void FreeLambdaInternalRep( - register Tcl_Obj *objPtr) /* CmdName object with internal representation + Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; @@ -2403,7 +2403,7 @@ FreeLambdaInternalRep( static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; diff --git a/generic/tclResult.c b/generic/tclResult.c index 1d758de..5e85e25 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -832,19 +832,19 @@ SetupAppendBuffer( totalSpace = newSpace + iPtr->appendUsed; if (totalSpace >= iPtr->appendAvl) { - char *newStr; + char *newSpace; if (totalSpace < 100) { totalSpace = 200; } else { totalSpace *= 2; } - newStr = (char *)ckalloc(totalSpace); - strcpy(newStr, iPtr->result); + newSpace = (char *)ckalloc(totalSpace); + strcpy(newSpace, iPtr->result); if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); } - iPtr->appendResult = newStr; + iPtr->appendResult = newSpace; iPtr->appendAvl = totalSpace; } else if (iPtr->result != iPtr->appendResult) { strcpy(iPtr->appendResult, iPtr->result); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index e677bd4..16a7a71 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3563,7 +3563,7 @@ TclStringFirst( } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *end, *tryIt, *bh; + unsigned char *end, *check, *bh; unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); /* Find bytes in bytes */ @@ -3574,25 +3574,25 @@ TclStringFirst( } end = bh + lh; - tryIt = bh + start; - while (tryIt + ln <= end) { + check = bh + start; + while (check + ln <= end) { /* * Look for the leading byte of the needle in the haystack - * starting at try and stopping when there's not enough room + * starting at check and stopping when there's not enough room * for the needle left. */ - tryIt = (unsigned char *)memchr(tryIt, bn[0], (end + 1 - ln) - tryIt); - if (tryIt == NULL) { + check = (unsigned char *)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(tryIt+1, bn+1, ln-1)) { + if (0 == memcmp(check+1, bn+1, ln-1)) { /* Checks! Return the successful index. */ - return (tryIt - bh); + return (check - bh); } /* Rest of needle match failed; Iterate to continue search. */ - tryIt++; + check++; } return -1; } @@ -3610,7 +3610,7 @@ TclStringFirst( */ { - Tcl_UniChar *tryIt, *end, *uh; + Tcl_UniChar *check, *end, *uh; Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); uh = Tcl_GetUnicodeFromObj(haystack, &lh); @@ -3620,10 +3620,10 @@ TclStringFirst( } end = uh + lh; - for (tryIt = uh + start; tryIt + ln <= end; tryIt++) { - if ((*tryIt == *un) && (0 == - memcmp(tryIt + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) { - return (tryIt - uh); + 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; @@ -3667,7 +3667,7 @@ TclStringLast( } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *tryIt, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); + unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); if (last >= lh) { @@ -3677,20 +3677,20 @@ TclStringLast( /* Don't start the loop if there cannot be a valid answer */ return -1; } - tryIt = bh + last + 1 - ln; + check = bh + last + 1 - ln; - while (tryIt >= bh) { - if ((*tryIt == bn[0]) - && (0 == memcmp(tryIt+1, bn+1, ln-1))) { - return (tryIt - bh); + while (check >= bh) { + if ((*check == bn[0]) + && (0 == memcmp(check+1, bn+1, ln-1))) { + return (check - bh); } - tryIt--; + check--; } return -1; } { - Tcl_UniChar *tryIt, *uh = Tcl_GetUnicodeFromObj(haystack, &lh); + Tcl_UniChar *check, *uh = Tcl_GetUnicodeFromObj(haystack, &lh); Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); if (last >= lh) { @@ -3700,13 +3700,13 @@ TclStringLast( /* Don't start the loop if there cannot be a valid answer */ return -1; } - tryIt = uh + last + 1 - ln; - while (tryIt >= uh) { - if ((*tryIt == un[0]) - && (0 == memcmp(tryIt+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) { - return (tryIt - uh); + 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); } - tryIt--; + check--; } return -1; } diff --git a/generic/tclTest.c b/generic/tclTest.c index 166334a..af68ad5 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2403,11 +2403,11 @@ ExitProcOdd( void *clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; - size_t len; + int len; - sprintf(buf, "odd %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData)); + sprintf(buf, "odd %d\n", (int)PTR2INT(clientData)); len = strlen(buf); - if (len != (size_t) write(1, buf, len)) { + if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcOdd: unable to write to stdout"); } } @@ -2417,11 +2417,11 @@ ExitProcEven( void *clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; - size_t len; + int len; - sprintf(buf, "even %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData)); + sprintf(buf, "even %d\n", (int)PTR2INT(clientData)); len = strlen(buf); - if (len != (size_t) write(1, buf, len)) { + if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcEven: unable to write to stdout"); } } diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c index 5c70a62..0aff0a7 100644 --- a/generic/tclThreadJoin.c +++ b/generic/tclThreadJoin.c @@ -230,7 +230,7 @@ TclRememberJoinableThread( { JoinableThread *threadPtr; - threadPtr = ckalloc(sizeof(JoinableThread)); + threadPtr = (JoinableThread *)ckalloc(sizeof(JoinableThread)); threadPtr->id = id; threadPtr->done = 0; threadPtr->waitedUpon = 0; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 983d62f..598520c 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -1167,7 +1167,7 @@ ZipFSOpenArchive( ZIPFS_POSIX_ERROR(interp, "file mapping failed"); goto error; } - zf->data = MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0, + zf->data = (unsigned char *)MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0, zf->length); if (!zf->data) { ZIPFS_POSIX_ERROR(interp, "file mapping failed"); diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index f80746f..c0da0ab 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -122,7 +122,7 @@ proc test-format {{reptime 1000}} { } proc test-scan {{reptime 1000}} { - _test_run $reptime { + _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) @@ -198,11 +198,11 @@ proc test-scan {{reptime 1000}} { # {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} - } {puts [clock format $_(r) -locale en]} + } } proc test-freescan {{reptime 1000}} { - _test_run $reptime { + _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 @@ -239,7 +239,7 @@ proc test-freescan {{reptime 1000}} { {clock scan "19:18:30 MST" -base 148863600 -gmt 1 clock scan "19:18:30 EST" -base 148863600 } - } {puts [clock format $_(r) -locale en]} + } } proc test-add {{reptime 1000}} { @@ -282,7 +282,7 @@ proc test-add {{reptime 1000}} { if {[catch {clock add 0 3 weekdays -gmt 1}]} { regsub -all {\mweekdays\M} $tests "days" tests } - _test_run $reptime $tests {puts [clock format $_(r) -locale en]} + _test_run -convert-result {clock format $_(r) -locale en} $reptime $tests } proc test-convert {{reptime 1000}} { diff --git a/tests-perf/test-performance.tcl b/tests-perf/test-performance.tcl index 78189e6..a715c8a 100644 --- a/tests-perf/test-performance.tcl +++ b/tests-perf/test-performance.tcl @@ -127,15 +127,23 @@ proc _adjust_maxcount {reptime maxcount} { proc _test_run {args} { upvar _ _ # parse args: - array set _ [set _opts {-no-result 0 -uplevel 0}] + array set _ {-no-result 0 -uplevel 0 -convert-result {}} while {[llength $args] > 2} { - if {[set o [lindex $args 0]] ni $_opts || $_($o)} { + if {![info exists _([set o [lindex $args 0]])]} { break } - set _($o) 1 - set args [lrange $args 1 end] + 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 _opts o + 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?\"" } @@ -173,7 +181,8 @@ proc _test_run {args} { # if output result (and not once): if {!$_(-no-result)} { set _(r) [if 1 $_(c)] - if {$_(outcmd) ne {}} {{*}$_(outcmd) $_(r)} + 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}] } diff --git a/tests/cmdAH.test b/tests/cmdAH.test index f8ab361..b15c77d 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -21,11 +21,16 @@ 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 time_t] >= 8 +}] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] global env set cmdAHwd [pwd] @@ -1290,6 +1295,22 @@ test cmdAH-24.14.1 { 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 @@ -1308,7 +1329,7 @@ test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup { test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} { file owned / } 0 -test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body { +test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints {win knownMsvcBug} -body { file owned $env(windir) } -result 0 test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body { diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 60b104f..e4db915 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -349,6 +349,24 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { "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 @@ -395,6 +413,11 @@ test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { "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 \ @@ -406,10 +429,10 @@ test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { 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}] + [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 @@ -430,6 +453,18 @@ test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} { 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 { diff --git a/tests/expr.test b/tests/expr.test index 59d96a1..bc01c03 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -729,7 +729,7 @@ test expr-18.1 {expr and conversion of operands to numbers} { catch {expr int($x)} expr {$x} } 11 -test expr-18.2 {whitespace strings should not be == 0 (buggy strtod)} { +test expr-18.2 {whitespace strings should not be == 0 (buggy strtol/strtoul)} { expr {" "} } { } diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 2494cb4..361542d 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -34,6 +34,7 @@ catch { 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 @@ -312,7 +313,7 @@ test filesystem-1.37 {file normalisation with '/./'} -body { } -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} test filesystem-1.38 {file normalisation with volume relative} -setup { set dir [pwd] -} -constraints {win moreThanOneDrive} -body { +} -constraints {win moreThanOneDrive knownMsvcBug} -body { set path "[string range [lindex $drives 0] 0 1]foo" cd [lindex $drives 1] file norm $path diff --git a/tests/format.test b/tests/format.test index 1bf46a1..3640376 100644 --- a/tests/format.test +++ b/tests/format.test @@ -20,6 +20,7 @@ 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 @@ -263,13 +264,13 @@ test format-6.1 {floating-point zeroes} {eformat} { 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} { +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} { +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} { diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 87ad4af..89afb0a 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -25,6 +25,7 @@ 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)]}] #---------------------------------------------------------------------- @@ -810,7 +811,7 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g rename foo {} set res } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}} -test iocmd-21.20 {Bug 88aef05cda} -setup { +test iocmd-21.20 {Bug 88aef05cda} -constraints knownMsvcBug -setup { proc foo {method chan args} { switch -- $method blocking { chan configure $chan -blocking [lindex $args 0] @@ -2015,7 +2016,7 @@ test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body { set c [chan create {r w} foo] set tock {} note [fileevent $c readable {lappend res TOCK; set tock 1}] - set stop [after 10000 {lappend res TIMEOUT; 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} @@ -2028,7 +2029,7 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { 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 10000 {lappend res TIMEOUT; 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} diff --git a/tests/socket.test b/tests/socket.test index b91668e..84320bd 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -75,6 +75,7 @@ if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env( # 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. @@ -2285,7 +2286,7 @@ test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is I removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ - -constraints {socket} \ + -constraints {socket knownMsvcBug} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 8a5173a..2bce77c 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -28,6 +28,7 @@ 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] @@ -393,7 +394,7 @@ proc MakeFiles {dirname} { test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup { cleanup -} -constraints {win winNonZeroInodes} -body { +} -constraints {win winNonZeroInodes knownMsvcBug} -body { file mkdir td1 foreach {a b} [MakeFiles td1] break file rename -force $a $b @@ -638,7 +639,7 @@ test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup { test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup -} -constraints {winVista testfile testchmod} -body { +} -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 @@ -692,7 +693,7 @@ test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup { } -result {1 {tf1 ENOTDIR}} test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup { cleanup -} -constraints {winVista testfile testchmod} -body { +} -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 @@ -710,7 +711,7 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup { } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup { cleanup -} -constraints {winVista testfile testchmod} -body { +} -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 @@ -939,7 +940,7 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup { } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup -} -constraints {winVista testfile testchmod} -body { +} -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1/td2 testchmod 0 td1 testfile rmdir -force td1 diff --git a/unix/configure b/unix/configure index 2de5b54..bf00034 100755 --- a/unix/configure +++ b/unix/configure @@ -3333,8 +3333,8 @@ esac #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: -# - stdlib.h doesn't define strtol, strtoul, or -# strtod insome versions of SunOS +# - 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 @@ -3825,19 +3825,6 @@ else fi rm -f conftest* - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <stdlib.h> - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strtod" >/dev/null 2>&1; then : - -else - tcl_ok=0 -fi -rm -f conftest* - if test $tcl_ok = 0; then $as_echo "#define NO_STDLIB_H 1" >>confdefs.h @@ -5660,7 +5647,7 @@ fi fi # The combo of gcc + glibc has a bug related to inlining of - # functions like strtod(). The -fno-builtin flag should address + # 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. diff --git a/unix/configure.ac b/unix/configure.ac index 74dbe08..ea4526c 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -89,8 +89,8 @@ AC_C_INLINE #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: -# - stdlib.h doesn't define strtol, strtoul, or -# strtod insome versions of SunOS +# - 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 diff --git a/unix/tcl.m4 b/unix/tcl.m4 index a206f26..70303ce 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1311,7 +1311,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ]) # The combo of gcc + glibc has a bug related to inlining of - # functions like strtod(). The -fno-builtin flag should address + # 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. @@ -1913,8 +1913,8 @@ dnl # preprocessing tests use only CPPFLAGS. # # Supply substitutes for missing POSIX header files. Special # notes: -# - stdlib.h doesn't define strtol, strtoul, or -# strtod insome versions of SunOS +# - 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 # @@ -1965,7 +1965,6 @@ closedir(d); 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) - AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0) if test $tcl_ok = 0; then AC_DEFINE(NO_STDLIB_H, 1, [Do we have <stdlib.h>?]) fi diff --git a/unix/tclLoadAix.c b/unix/tclLoadAix.c index e5d9729..fea9494 100644 --- a/unix/tclLoadAix.c +++ b/unix/tclLoadAix.c @@ -98,7 +98,7 @@ dlopen( const char *path, int mode) { - register ModulePtr mp; + ModulePtr mp; static void *mainModule; /* @@ -191,7 +191,7 @@ dlopen( */ if (mode & RTLD_GLOBAL) { - register ModulePtr mp1; + ModulePtr mp1; for (mp1 = mp->next; mp1; mp1 = mp1->next) { if (loadbind(0, mp1->entry, mp->entry) == -1) { @@ -243,7 +243,7 @@ static void caterr( char *s) { - register char *p = s; + char *p = s; while (*p >= '0' && *p <= '9') { p++; @@ -282,9 +282,9 @@ dlsym( void *handle, const char *symbol) { - register ModulePtr mp = (ModulePtr)handle; - register ExportPtr ep; - register int i; + ModulePtr mp = (ModulePtr)handle; + ExportPtr ep; + int i; /* * Could speed up the search, but I assume that one assigns the result to @@ -317,9 +317,9 @@ int dlclose( void *handle) { - register ModulePtr mp = (ModulePtr)handle; + ModulePtr mp = (ModulePtr)handle; int result; - register ModulePtr mp1; + ModulePtr mp1; if (--mp->refCnt > 0) { return 0; @@ -343,8 +343,8 @@ dlclose( } if (mp->exports) { - register ExportPtr ep; - register int i; + ExportPtr ep; + int i; for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { if (ep->name) { free(ep->name); diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index 4f78971..cd62f6a 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -210,6 +210,9 @@ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); */ #if defined(__CYGWIN__) +#ifdef __cplusplus +extern "C" { +#endif typedef struct { void *hwnd; /* Messaging window. */ unsigned int *message; /* Message payload. */ @@ -260,6 +263,9 @@ extern unsigned char __stdcall TranslateMessage(const MSG *); static const wchar_t className[] = L"TclNotifier"; static DWORD __stdcall NotifierProc(void *hwnd, unsigned int message, void *wParam, void *lParam); +#ifdef __cplusplus +} +#endif #endif /* TCL_THREADS && __CYGWIN__ */ diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 7da0f45..e723b55 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -685,8 +685,8 @@ CopyGrp( char *buf, int buflen) { - register char *p = buf; - register int copied, len = 0; + char *p = buf; + int copied, len = 0; /* * Copy username. @@ -887,7 +887,7 @@ CopyArray( int buflen) /* Size of buffer. */ { int i, j, len = 0; - char *p, **pp; + char *p, **newBuffer; if (src == NULL) { return 0; @@ -903,7 +903,7 @@ CopyArray( return -1; } - pp = (char **) buf; + newBuffer = (char **) buf; p = buf + len; for (j = 0; j < i; j++) { @@ -914,10 +914,10 @@ CopyArray( return -1; } memcpy(p, src[j], sz); - pp[j] = p; + newBuffer[j] = p; p = buf + len; } - pp[j] = NULL; + newBuffer[j] = NULL; return len; } diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 4931182..2c85c4d 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -113,16 +113,8 @@ typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, * elsewhere in Tcl's core. */ -#ifdef DJGPP - -/* - * See contrib/djgpp/tclDjgppFCmd.c for definition. - */ - -extern TclFileAttrProcs tclpFileAttrProcs[]; -extern const char *const tclpFileAttrStrings[]; +#ifndef DJGPP -#else /* !DJGPP */ enum { #if defined(__CYGWIN__) UNIX_ARCHIVE_ATTRIBUTE, @@ -145,7 +137,6 @@ enum { UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */ }; -MODULE_SCOPE const char *const tclpFileAttrStrings[]; const char *const tclpFileAttrStrings[] = { #if defined(__CYGWIN__) "-archive", @@ -167,7 +158,6 @@ const char *const tclpFileAttrStrings[] = { NULL }; -MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; const TclFileAttrProcs tclpFileAttrProcs[] = { #if defined(__CYGWIN__) {GetUnixFileAttributes, SetUnixFileAttributes}, diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 7406991..e26e657 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -33,11 +33,17 @@ #endif #ifdef __CYGWIN__ +#ifdef __cplusplus +extern "C" { +#endif DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *); DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *); DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); +#ifdef __cplusplus +} +#endif #define NUMPROCESSORS 11 static const char *const processors[NUMPROCESSORS] = { @@ -411,7 +417,7 @@ TclpInitPlatform(void) /* * 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 strtod, but should not have locale dependent + * relies on routines like strtol/strtoul, but should not have locale dependent * behavior. */ @@ -1001,7 +1007,7 @@ TclpFindVariable( * searches). */ { int i, result = -1; - register const char *env, *p1, *p2; + const char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index c982585..4aa842e 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -87,6 +87,9 @@ typedef off_t Tcl_SeekOffset; #ifdef __CYGWIN__ +#ifdef __cplusplus +extern "C" { +#endif /* Make some symbols available without including <windows.h> */ # define DWORD unsigned int # define CP_UTF8 65001 @@ -117,6 +120,9 @@ typedef off_t Tcl_SeekOffset; # define timezone _timezone extern int TclOSstat(const char *name, void *statBuf); extern int TclOSlstat(const char *name, void *statBuf); +#ifdef __cplusplus +} +#endif #elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) # define TclOSstat stat64 # define TclOSlstat lstat64 diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 30e19ca..5cc937f 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -844,7 +844,7 @@ Tcl_Mutex * TclpNewAllocMutex(void) { AllocMutex *lockPtr; - register PMutex *plockPtr; + PMutex *plockPtr; lockPtr = (AllocMutex *)malloc(sizeof(AllocMutex)); if (lockPtr == NULL) { @@ -28,14 +28,14 @@ _tmain(void) const char *err; while (1) { - n = read(0, buf, sizeof(buf)); + n = _read(0, buf, sizeof(buf)); if (n <= 0) { break; } - write(1, buf, n); + _write(1, buf, n); } err = (sizeof(int) == 2) ? "stderr16" : "stderr32"; - write(2, err, strlen(err)); + _write(2, err, (unsigned int)strlen(err)); return 0; } diff --git a/win/configure b/win/configure index 982f96a..b0e1d5a 100755 --- a/win/configure +++ b/win/configure @@ -778,6 +778,7 @@ ac_user_opts=' enable_option_checking with_encoding enable_shared +enable_time64bit enable_64bit enable_zipfs enable_symbols @@ -1400,6 +1401,7 @@ Optional Features: --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) @@ -3749,6 +3751,25 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h #-------------------------------------------------------------------- +# 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. diff --git a/win/configure.ac b/win/configure.ac index 7b63c61..82d713a 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -92,6 +92,20 @@ SC_TCL_CFG_ENCODING 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. diff --git a/win/makefile.vc b/win/makefile.vc index 44af015..c2343a0 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -51,6 +51,71 @@ # 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
diff --git a/win/rules.vc b/win/rules.vc index 1cd0b68..3fa0704 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -686,6 +686,9 @@ LINKERFLAGS = $(LINKERFLAGS) -ltcg # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking
# CONFIG_CHECK - 1 -> check current build configuration against Tcl
# configuration (ignored for Tcl itself)
+# _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
@@ -745,6 +748,16 @@ TCL_USE_STATIC_PACKAGES = 1 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"]
@@ -1305,6 +1318,13 @@ OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT 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
diff --git a/win/tcl.dsp b/win/tcl.dsp index eae1681..065d598 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -148,10 +148,6 @@ SOURCE=..\compat\dlfcn.h # End Source File
# Begin Source File
-SOURCE=..\compat\fixstrtod.c
-# End Source File
-# Begin Source File
-
SOURCE=..\compat\gettod.c
# End Source File
# Begin Source File
@@ -188,10 +184,6 @@ SOURCE=..\compat\strstr.c # End Source File
# Begin Source File
-SOURCE=..\compat\strtod.c
-# End Source File
-# Begin Source File
-
SOURCE=..\compat\strtol.c
# End Source File
# Begin Source File
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 9e5885c..989d547 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -385,8 +385,8 @@ TclWinDriveLetterForVolMountPoint( } } if (!alreadyStored) { - dlPtr2 = ckalloc(sizeof(MountPointMap)); - dlPtr2->volumeName = TclNativeDupInternalRep(Target); + dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); + dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target); dlPtr2->driveLetter = (char) drive[0]; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; @@ -411,8 +411,8 @@ TclWinDriveLetterForVolMountPoint( * that fact and store '-1' so we don't have to look it up each time. */ - dlPtr2 = ckalloc(sizeof(MountPointMap)); - dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint); + dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); + dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((ClientData) mountPoint); dlPtr2->driveLetter = -1; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; @@ -475,7 +475,7 @@ Tcl_WinUtfToTChar( if (!string) { return NULL; } - return TclUtfToWCharDString(string, len, dsPtr); + return (WCHAR *)TclUtfToWCharDString(string, len, dsPtr); } char * diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 3b6e4e4..a2a7942 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -267,7 +267,7 @@ FileCheckProc( infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) { SET_FLAG(infoPtr->flags, FILE_PENDING); - evPtr = ckalloc(sizeof(FileEvent)); + evPtr = (FileEvent *)ckalloc(sizeof(FileEvent)); evPtr->header.proc = FileEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -350,7 +350,7 @@ FileBlockProc( int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; /* * Files on Windows can not be switched between blocking and nonblocking, @@ -388,7 +388,7 @@ FileCloseProc( ClientData instanceData, /* Pointer to FileInfo structure. */ Tcl_Interp *interp) /* Not used. */ { - FileInfo *fileInfoPtr = instanceData; + FileInfo *fileInfoPtr = (FileInfo *)instanceData; FileInfo *infoPtr; ThreadSpecificData *tsdPtr; int errorCode = 0; @@ -463,7 +463,7 @@ FileSeekProc( int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; DWORD moveMethod; @@ -541,7 +541,7 @@ FileWideSeekProc( int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; DWORD moveMethod; LONG newPos, newPosHigh; @@ -591,7 +591,7 @@ FileTruncateProc( ClientData instanceData, /* File state. */ Tcl_WideInt length) /* Length to truncate at. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; /* @@ -669,7 +669,7 @@ FileInputProc( int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; DWORD bytesRead; *errorCode = 0; @@ -724,7 +724,7 @@ FileOutputProc( int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; DWORD bytesWritten; *errorCode = 0; @@ -771,7 +771,7 @@ FileWatchProc( * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; Tcl_Time blockTime = { 0, 0 }; /* @@ -809,7 +809,7 @@ FileGetHandleProc( int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; if (!TEST_FLAG(direction, infoPtr->validMask)) { return TCL_ERROR; @@ -854,7 +854,7 @@ TclpOpenFileChannel( char channelName[16 + TCL_INTEGER_SPACE]; TclFile readFile = NULL, writeFile = NULL; - nativeName = Tcl_FSGetNativePath(pathPtr); + nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1365,7 +1365,7 @@ TclWinOpenFileChannel( } } - infoPtr = ckalloc(sizeof(FileInfo)); + infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo)); /* * TIP #218. Removed the code inserting the new structure into the global @@ -1456,7 +1456,7 @@ FileThreadActionProc( int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { infoPtr->nextPtr = tsdPtr->firstFilePtr; diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 3668ae3..8456fcb 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -462,7 +462,7 @@ ConsoleCheckProc( } if (needEvent) { - ConsoleEvent *evPtr = ckalloc(sizeof(ConsoleEvent)); + ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent)); infoPtr->flags |= CONSOLE_PENDING; evPtr->header.proc = ConsoleEventProc; @@ -494,7 +494,7 @@ ConsoleBlockModeProc( int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; /* * Consoles on Windows can not be switched between blocking and @@ -533,7 +533,7 @@ ConsoleCloseProc( ClientData instanceData, /* Pointer to ConsoleInfo structure. */ Tcl_Interp *interp) /* For error reporting. */ { - ConsoleInfo *consolePtr = instanceData; + ConsoleInfo *consolePtr = (ConsoleInfo *)instanceData; int errorCode = 0; ConsoleInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -651,7 +651,7 @@ ConsoleInputProc( * buffer? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; DWORD count, bytesRead = 0; int result; @@ -743,7 +743,7 @@ ConsoleOutputProc( int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; ConsoleThreadInfo *threadInfo = &infoPtr->writer; DWORD bytesWritten, timeout; @@ -787,7 +787,7 @@ ConsoleOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc(toWrite); + infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; @@ -928,7 +928,7 @@ ConsoleWatchProc( * TCL_EXCEPTION. */ { ConsoleInfo **nextPtrPtr, *ptr; - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; int oldMask = infoPtr->watchMask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -986,7 +986,7 @@ ConsoleGetHandleProc( int direction, /* TCL_READABLE or TCL_WRITABLE. */ ClientData *handlePtr) /* Where to store the handle. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; *handlePtr = infoPtr->handle; return TCL_OK; @@ -1020,7 +1020,7 @@ WaitForRead( * or not. */ { DWORD timeout, count; - HANDLE *handle = infoPtr->handle; + HANDLE *handle = (HANDLE *)infoPtr->handle; ConsoleThreadInfo *threadInfo = &infoPtr->reader; INPUT_RECORD input; @@ -1136,7 +1136,7 @@ ConsoleReaderThread( } if (!infoPtr) { infoPtr = (ConsoleInfo *)pipeTI->clientData; - handle = infoPtr->handle; + handle = (HANDLE *)infoPtr->handle; threadInfo = &infoPtr->reader; } @@ -1234,7 +1234,7 @@ ConsoleWriterThread( } if (!infoPtr) { infoPtr = (ConsoleInfo *)pipeTI->clientData; - handle = infoPtr->handle; + handle = (HANDLE *)infoPtr->handle; threadInfo = &infoPtr->writer; } @@ -1321,7 +1321,7 @@ TclWinOpenConsoleChannel( * See if a channel with this handle already exists. */ - infoPtr = ckalloc(sizeof(ConsoleInfo)); + infoPtr = (ConsoleInfo *)ckalloc(sizeof(ConsoleInfo)); memset(infoPtr, 0, sizeof(ConsoleInfo)); infoPtr->validMask = permissions; @@ -1405,7 +1405,7 @@ ConsoleThreadActionProc( ClientData instanceData, int action) { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; /* * We do not access firstConsolePtr in the thread structures. This is not @@ -1459,7 +1459,7 @@ ConsoleSetOptionProc( const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; int len = strlen(optionName); int vlen = strlen(value); @@ -1557,7 +1557,7 @@ ConsoleGetOptionProc( const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; int valid = 0; /* Flag if valid option parsed. */ unsigned int len; char buf[TCL_INTEGER_SPACE]; diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 06e7878..9c04c2d 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -11,6 +11,8 @@ */ #undef STATIC_BUILD +#undef TCL_UTF_MAX +#define TCL_UTF_MAX 3 #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif @@ -34,7 +36,7 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - TCHAR *name; /* Interpreter's name (malloc-ed). */ + WCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -101,7 +103,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, - const TCHAR *serviceName, const TCHAR *topicName); + 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); @@ -111,7 +113,7 @@ static void DeleteProc(ClientData clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, - const TCHAR *name, HCONV *ddeConvPtr); + const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, @@ -159,7 +161,7 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.1", 0)) { + if (!Tcl_InitStubs(interp, "8.5-", 0)) { return TCL_ERROR; } @@ -283,10 +285,10 @@ Initialize(void) *---------------------------------------------------------------------- */ -static const TCHAR * +static const WCHAR * DdeSetServerName( Tcl_Interp *interp, - const TCHAR *name, /* The name that will be used to refer to the + 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 */ @@ -296,7 +298,7 @@ DdeSetServerName( int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - const TCHAR *actualName; + const WCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -355,8 +357,9 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString); - OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); + Tcl_DStringInit(&dString); + Tcl_UtfToUniCharDString(Tcl_GetString(Tcl_GetObjResult(interp)), -1, &dString); + OutputDebugString((WCHAR *) Tcl_DStringValue(&dString)); Tcl_DStringFree(&dString); return NULL; } @@ -374,13 +377,13 @@ DdeSetServerName( lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR)); - Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR)); + 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(TCHAR) * TCL_INTEGER_SPACE); - actualName = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + sizeof(WCHAR) * TCL_INTEGER_SPACE); + actualName = (WCHAR *) Tcl_DStringValue(&dString); } - _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), + _snwprintf((WCHAR *) (Tcl_DStringValue(&dString) + offset), TCL_INTEGER_SPACE, TEXT("%d"), suffix); } @@ -393,8 +396,9 @@ DdeSetServerName( Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); - if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { + Tcl_DStringInit(&ds); + Tcl_UtfToUniCharDString(Tcl_GetString(namePtr), -1, &ds); + if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); break; @@ -410,14 +414,14 @@ DdeSetServerName( riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR)); + 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; - _tcscpy(riPtr->name, actualName); + wcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); @@ -633,7 +637,7 @@ DdeServerProc( Tcl_DString dString; size_t len; DWORD dlen; - TCHAR *utilString; + WCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -649,14 +653,14 @@ DdeServerProc( len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&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 (_tcsicmp(utilString, riPtr->name) == 0) { + if (_wcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -674,13 +678,13 @@ DdeServerProc( len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&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 (_tcsicmp(riPtr->name, utilString) == 0) { + if (_wcsicmp(riPtr->name, utilString) == 0) { convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; @@ -743,18 +747,19 @@ DdeServerProc( len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringInit(&dsBuf); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); - if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { returnString = Tcl_GetString(convPtr->returnPackagePtr); len = convPtr->returnPackagePtr->length; if (uFmt != CF_TEXT) { - Tcl_WinUtfToTChar(returnString, len, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToUniCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1; + len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -765,7 +770,8 @@ DdeServerProc( Tcl_DString ds; Tcl_Obj *variableObjPtr; - Tcl_WinTCharToUtf(utilString, -1, &ds); + Tcl_DStringInit(&ds); + Tcl_UniCharToUtfDString((Tcl_UniChar *)utilString, wcslen(utilString), &ds); variableObjPtr = Tcl_GetVar2Ex( convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); @@ -773,9 +779,10 @@ DdeServerProc( returnString = Tcl_GetString(variableObjPtr); len = variableObjPtr->length; if (uFmt != CF_TEXT) { - Tcl_WinUtfToTChar(returnString, len, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToUniCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1; + len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -818,16 +825,18 @@ DdeServerProc( Tcl_DStringInit(&dString); Tcl_DStringInit(&ds2); len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); - Tcl_WinTCharToUtf(utilString, -1, &ds); - utilString = (TCHAR *) DdeAccessData(hData, &len2); + Tcl_DStringInit(&ds); + Tcl_UniCharToUtfDString((Tcl_UniChar *)utilString, wcslen(utilString), &ds); + utilString = (WCHAR *) DdeAccessData(hData, &len2); len = len2; if (uFmt != CF_TEXT) { - Tcl_WinTCharToUtf(utilString, -1, &ds2); - utilString = (TCHAR *) Tcl_DStringValue(&ds2); + Tcl_DStringInit(&ds2); + Tcl_UniCharToUtfDString((Tcl_UniChar *)utilString, wcslen(utilString), &ds2); + utilString = (WCHAR *) Tcl_DStringValue(&ds2); } variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); @@ -862,7 +871,7 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (TCHAR *) DdeAccessData(hData, &dlen); + utilString = (WCHAR *) DdeAccessData(hData, &dlen); string = (char *) utilString; if (!dlen) { /* Empty binary array. */ @@ -877,7 +886,8 @@ DdeServerProc( /* unicode */ Tcl_DString dsBuf; - Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UniCharToUtfDString((Tcl_UniChar *)utilString, (dlen>>1) - 1, &dsBuf); ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); @@ -993,7 +1003,7 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - const TCHAR *name, /* The connection to use. */ + const WCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; @@ -1010,7 +1020,8 @@ MakeDdeConnection( if (interp != NULL) { Tcl_DString dString; - Tcl_WinTCharToUtf(name, -1, &dString); + Tcl_DStringInit(&dString); + Tcl_UniCharToUtfDString((Tcl_UniChar *)name, wcslen(name), &dString); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no registered server named \"%s\"", Tcl_DStringValue(&dString))); Tcl_DStringFree(&dString); @@ -1048,8 +1059,8 @@ DdeCreateClient( DdeEnumServices *es) { WNDCLASSEX wc; - static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); - static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window"); + 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); @@ -1104,7 +1115,7 @@ DdeServicesOnAck( ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); DdeEnumServices *es; - TCHAR sz[255]; + WCHAR sz[255]; Tcl_DString dString; #ifdef _WIN64 @@ -1119,11 +1130,13 @@ DdeServicesOnAck( Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomName(service, sz, 255); - Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_DStringInit(&dString); + Tcl_UniCharToUtfDString((Tcl_UniChar *)sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); GlobalGetAtomName(topic, sz, 255); - Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_DStringInit(&dString); + Tcl_UniCharToUtfDString((Tcl_UniChar *)sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); @@ -1172,8 +1185,8 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const TCHAR *serviceName, - const TCHAR *topicName) + const WCHAR *serviceName, + const WCHAR *topicName) { DdeEnumServices es; @@ -1302,7 +1315,7 @@ DdeObjCmd( HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - const TCHAR *serviceName = NULL, *topicName = NULL; + const WCHAR *serviceName = NULL, *topicName = NULL; const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; @@ -1462,9 +1475,10 @@ DdeObjCmd( const char *src = Tcl_GetString(objv[firstArg]); length = objv[firstArg]->length; - Tcl_WinUtfToTChar(src, length, &serviceBuf); - serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf); - length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR); + Tcl_DStringInit(&serviceBuf); + Tcl_UtfToUniCharDString(src, length, &serviceBuf); + serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); + length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR); } else { length = 0; } @@ -1480,8 +1494,9 @@ DdeObjCmd( const char *src = Tcl_GetString(objv[firstArg + 1]); length = objv[firstArg + 1]->length; - topicName = Tcl_WinUtfToTChar(src, length, &topicBuf); - length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR); + Tcl_DStringInit(&topicBuf); + topicName = (const WCHAR *)Tcl_UtfToUniCharDString(src, length, &topicBuf); + length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); if (length == 0) { topicName = NULL; } else { @@ -1497,7 +1512,8 @@ DdeObjCmd( if (serviceName != NULL) { Tcl_DString dsBuf; - Tcl_WinTCharToUtf(serviceName, -1, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UniCharToUtfDString((Tcl_UniChar *)serviceName, wcslen(serviceName), &dsBuf); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf))); Tcl_DStringFree(&dsBuf); @@ -1520,9 +1536,10 @@ DdeObjCmd( src = Tcl_GetString(objv[firstArg + 2]); dataLength = objv[firstArg + 2]->length; - dataString = (const TCHAR *) - Tcl_WinUtfToTChar(src, dataLength, &dsBuf); - dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + Tcl_DStringInit(&dsBuf); + dataString = (const WCHAR *) + Tcl_UtfToUniCharDString(src, dataLength, &dsBuf); + dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } if (dataLength + 1 < 2) { @@ -1568,13 +1585,14 @@ DdeObjCmd( break; } case DDE_REQUEST: { - const TCHAR *itemString; + const WCHAR *itemString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; - itemString = Tcl_WinUtfToTChar(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR); + Tcl_DStringInit(&itemBuf); + itemString = (const WCHAR *)Tcl_UtfToUniCharDString(src, length, &itemBuf); + length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, @@ -1602,7 +1620,7 @@ DdeObjCmd( result = TCL_ERROR; } else { DWORD tmp; - TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp); + WCHAR *dataString = (WCHAR *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { returnObjPtr = @@ -1610,11 +1628,12 @@ DdeObjCmd( } else { Tcl_DString dsBuf; - if ((tmp >= sizeof(TCHAR)) - && !dataString[tmp / sizeof(TCHAR) - 1]) { - tmp -= sizeof(TCHAR); + if ((tmp >= sizeof(WCHAR)) + && !dataString[tmp / sizeof(WCHAR) - 1]) { + tmp -= sizeof(WCHAR); } - Tcl_WinTCharToUtf(dataString, tmp, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UniCharToUtfDString((Tcl_UniChar *)dataString, tmp>>1, &dsBuf); returnObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); @@ -1633,14 +1652,15 @@ DdeObjCmd( } case DDE_POKE: { Tcl_DString dsBuf; - const TCHAR *itemString; + const WCHAR *itemString; BYTE *dataString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; - itemString = Tcl_WinUtfToTChar(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR); + Tcl_DStringInit(&itemBuf); + itemString = (const WCHAR *)Tcl_UtfToUniCharDString(src, length, &itemBuf); + length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); @@ -1656,9 +1676,10 @@ DdeObjCmd( const char *data = Tcl_GetString(objv[firstArg + 3]); length = objv[firstArg + 3]->length; + Tcl_DStringInit(&dsBuf); dataString = (BYTE *) - Tcl_WinUtfToTChar(data, length, &dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + Tcl_UtfToUniCharDString(data, length, &dsBuf); + length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); @@ -1717,7 +1738,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(serviceName, riPtr->name) == 0) { + if (_wcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1820,9 +1841,10 @@ DdeObjCmd( objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetString(objPtr); length = objPtr->length; - Tcl_WinUtfToTChar(string, length, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToUniCharDString(string, length, &dsBuf); string = Tcl_DStringValue(&dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, (DWORD) length, 0, 0, CF_UNICODETEXT, 0); Tcl_DStringFree(&dsBuf); @@ -1854,7 +1876,7 @@ DdeObjCmd( if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; - TCHAR *ddeDataString; + WCHAR *ddeDataString; /* * The return handle has a two or four element list in it. The @@ -1866,12 +1888,13 @@ DdeObjCmd( */ length = DdeGetData(ddeData, NULL, 0, 0); - ddeDataString = (TCHAR *) Tcl_Alloc(length); + ddeDataString = (WCHAR *) Tcl_Alloc(length); DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); - if (length > sizeof(TCHAR)) { - length -= sizeof(TCHAR); + if (length > sizeof(WCHAR)) { + length -= sizeof(WCHAR); } - Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UniCharToUtfDString((Tcl_UniChar *)ddeDataString, length>>1, &dsBuf); resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 78489ca..0ef3b65 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -145,8 +145,8 @@ TclpObjRenameFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoRenameFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr), + (const WCHAR *)Tcl_FSGetNativePath(destPathPtr)); } static int @@ -534,8 +534,8 @@ TclpObjCopyFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoCopyFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr), + (const WCHAR *)Tcl_FSGetNativePath(destPathPtr)); } static int @@ -749,7 +749,7 @@ TclpDeleteFile( const void *nativePath) /* Pathname of file to be removed (native). */ { DWORD attr; - const WCHAR *path = nativePath; + const WCHAR *path = (const WCHAR *)nativePath; /* * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and @@ -854,7 +854,7 @@ int TclpObjCreateDirectory( Tcl_Obj *pathPtr) { - return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); + return DoCreateDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr)); } static int @@ -988,7 +988,7 @@ TclpObjRemoveDirectory( ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { - ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds); + ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds); } if (ret != TCL_OK) { @@ -1506,7 +1506,7 @@ GetWinFileAttributes( const WCHAR *nativeName; int attr; - nativeName = Tcl_FSGetNativePath(fileName); + nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName); result = GetFileAttributes(nativeName); if (result == 0xffffffff) { @@ -1831,7 +1831,7 @@ SetWinFileAttributes( int yesNo, result; const WCHAR *nativeName; - nativeName = Tcl_FSGetNativePath(fileName); + nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName); fileAttributes = old = GetFileAttributes(nativeName); if (fileAttributes == 0xffffffff) { diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 1c4379a..233455a 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -937,7 +937,7 @@ TclpMatchInDirectory( WIN32_FILE_ATTRIBUTE_DATA data; const char *str = TclGetStringFromObj(norm, &len); - native = Tcl_FSGetNativePath(pathPtr); + native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (GetFileAttributesEx(native, GetFileExInfoStandard, &data) != TRUE) { @@ -978,7 +978,7 @@ TclpMatchInDirectory( * Verify that the specified path exists and is actually a directory. */ - native = Tcl_FSGetNativePath(pathPtr); + native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (native == NULL) { return TCL_OK; } @@ -1471,14 +1471,14 @@ TclpGetUserHome( Tcl_DStringFree(&ds); } else { Tcl_DStringInit(&ds); - wName = TclUtfToWCharDString(domain + 1, -1, &ds); + wName = (WCHAR *)TclUtfToWCharDString(domain + 1, -1, &ds); rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain); Tcl_DStringFree(&ds); nameLen = domain - name; } if (rc == 0) { Tcl_DStringInit(&ds); - wName = TclUtfToWCharDString(name, nameLen, &ds); + wName = (WCHAR *)TclUtfToWCharDString(name, nameLen, &ds); while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) { /* * User does not exist; if domain was not specified, try again @@ -1498,7 +1498,7 @@ TclpGetUserHome( if (rc != 0) { break; } - domain = INT2PTR(-1); /* repeat once */ + domain = (const char *)INT2PTR(-1); /* repeat once */ } if (rc == 0) { DWORD i, size = MAX_PATH; @@ -1506,7 +1506,7 @@ TclpGetUserHome( wHomeDir = uiPtr->usri1_home_dir; if ((wHomeDir != NULL) && (wHomeDir[0] != '\0')) { size = lstrlenW(wHomeDir); - TclWCharToUtfDString(wHomeDir, size, bufferPtr); + TclWCharToUtfDString((const unsigned short *)wHomeDir, size, bufferPtr); } else { /* * User exists but has no home dir. Return @@ -1514,7 +1514,7 @@ TclpGetUserHome( */ GetProfilesDirectoryW(buf, &size); - TclWCharToUtfDString(buf, size-1, bufferPtr); + TclWCharToUtfDString((const unsigned short *)buf, size-1, bufferPtr); Tcl_DStringAppend(bufferPtr, "/", 1); Tcl_DStringAppend(bufferPtr, name, nameLen); } @@ -1917,7 +1917,7 @@ TclpObjChdir( int result; const WCHAR *nativePath; - nativePath = Tcl_FSGetNativePath(pathPtr); + nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (!nativePath) { return -1; @@ -2009,7 +2009,7 @@ TclpObjStat( TclWinFlushDirtyChannels(); - return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0); + return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 0); } /* @@ -2378,7 +2378,7 @@ TclpObjAccess( Tcl_Obj *pathPtr, int mode) { - return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode); + return NativeAccess((const WCHAR *)Tcl_FSGetNativePath(pathPtr), mode); } int @@ -2394,7 +2394,7 @@ TclpObjLstat( TclWinFlushDirtyChannels(); - return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1); + return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 1); } #ifdef S_IFLNK @@ -2407,14 +2407,14 @@ TclpObjLink( if (toPtr != NULL) { int res; const WCHAR *LinkTarget; - const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); + const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr); if (normalizedToPtr == NULL) { return NULL; } - LinkTarget = Tcl_FSGetNativePath(normalizedToPtr); + LinkTarget = (const WCHAR *)Tcl_FSGetNativePath(normalizedToPtr); if (LinkSource == NULL || LinkTarget == NULL) { return NULL; @@ -2426,7 +2426,7 @@ TclpObjLink( return NULL; } } else { - const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); + const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (LinkSource == NULL) { return NULL; @@ -2475,13 +2475,13 @@ TclpFilesystemPathType( firstSeparator = strchr(path, '/'); if (firstSeparator == NULL) { - found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr), + found = GetVolumeInformation((const WCHAR *)Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); } else { Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); Tcl_IncrRefCount(driveName); - found = GetVolumeInformation(Tcl_FSGetNativePath(driveName), + found = GetVolumeInformation((const WCHAR *)Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); Tcl_DecrRefCount(driveName); } @@ -3097,7 +3097,7 @@ TclNativeCreateNativeRep( * Overallocate 6 chars, making some room for extended paths */ - wp = nativePathPtr = ckalloc((len + 6) * sizeof(WCHAR)); + wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { goto done; } @@ -3195,7 +3195,7 @@ TclNativeDupInternalRep( len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); - copy = ckalloc(len); + copy = (char *)ckalloc(len); memcpy(copy, clientData, len); return copy; } @@ -3232,7 +3232,7 @@ TclpUtime( FromCTime(tval->actime, &lastAccessTime); FromCTime(tval->modtime, &lastModTime); - native = Tcl_FSGetNativePath(pathPtr); + native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); attr = GetFileAttributes(native); @@ -3283,7 +3283,7 @@ TclWinFileOwned( DWORD bufsz; int owned = 0; - native = Tcl_FSGetNativePath(pathPtr); + native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, @@ -3311,7 +3311,7 @@ TclWinFileOwned( bufsz = 0; GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); if (bufsz) { - buf = ckalloc(bufsz); + buf = (LPBYTE)ckalloc(bufsz); if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index f4c6e06..7a0c714 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -226,7 +226,7 @@ TclpInitLibraryPath( *encodingPtr = NULL; bytes = TclGetStringFromObj(pathPtr, &length); *lengthPtr = length++; - *valuePtr = ckalloc(length); + *valuePtr = (char *)ckalloc(length); memcpy(*valuePtr, bytes, length); Tcl_DecrRefCount(pathPtr); } @@ -363,7 +363,7 @@ InitializeDefaultLibraryDir( TclWinNoBackslash(name); sprintf(end + 1, "lib/tcl%s", TCL_VERSION); *lengthPtr = strlen(name); - *valuePtr = ckalloc(*lengthPtr + 1); + *valuePtr = (char *)ckalloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } @@ -411,7 +411,7 @@ InitializeSourceLibraryDir( TclWinNoBackslash(name); sprintf(end + 1, "../library"); *lengthPtr = strlen(name); - *valuePtr = ckalloc(*lengthPtr + 1); + *valuePtr = (char *)ckalloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } @@ -628,7 +628,7 @@ TclpFindVariable( * searches). */ { int i, length, result = -1; - register const char *env, *p1, *p2; + const char *env, *p1, *p2; char *envUpper, *nameUpper; Tcl_DString envString; @@ -637,7 +637,7 @@ TclpFindVariable( */ length = strlen(name); - nameUpper = ckalloc(length + 1); + nameUpper = (char *)ckalloc(length + 1); memcpy(nameUpper, name, length+1); Tcl_UtfToUpper(nameUpper); diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index dc673d2..df114f2 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -74,7 +74,7 @@ TclpDlopen( * relative path. */ - nativeName = Tcl_FSGetNativePath(pathPtr); + nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (nativeName != NULL) { hInstance = LoadLibraryEx(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); @@ -170,7 +170,7 @@ TclpDlopen( * Succeded; package everything up for Tcl. */ - handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_)); + handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); handlePtr->clientData = (ClientData) hInstance; handlePtr->findSymbolProcPtr = &FindSymbol; handlePtr->unloadFileProcPtr = &UnloadFile; @@ -202,14 +202,14 @@ FindSymbol( const char *symbol) { HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; - Tcl_PackageInitProc *proc = NULL; + void *proc = NULL; /* * For each symbol, check for both Symbol and _Symbol, since Borland * generates C symbols with a leading '_' by default. */ - proc = (void *) GetProcAddress(hInstance, symbol); + proc = (void *)GetProcAddress(hInstance, symbol); if (proc == NULL) { Tcl_DString ds; const char *sym2; @@ -217,7 +217,7 @@ FindSymbol( Tcl_DStringInit(&ds); TclDStringAppendLiteral(&ds, "_"); sym2 = Tcl_DStringAppend(&ds, symbol, -1); - proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2); + proc = (void *)GetProcAddress(hInstance, sym2); Tcl_DStringFree(&ds); } if (proc == NULL && interp != NULL) { @@ -416,7 +416,7 @@ InitDLLDirectoryName(void) */ copyToGlobalBuffer: - dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR)); + dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR)); wcscpy(dllDirectoryName, name); return TCL_OK; } diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 89a1b66..dba7a31 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -83,7 +83,6 @@ Tcl_InitNotifier(void) return tclNotifierHooks.initNotifierProc(); } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - WNDCLASS class; TclpMasterLock(); if (!initialized) { @@ -99,18 +98,20 @@ Tcl_InitNotifier(void) EnterCriticalSection(¬ifierMutex); if (notifierCount == 0) { - class.style = 0; - class.cbClsExtra = 0; - class.cbWndExtra = 0; - class.hInstance = TclWinGetTclInstance(); - class.hbrBackground = NULL; - class.lpszMenuName = NULL; - class.lpszClassName = className; - class.lpfnWndProc = NotifierProc; - class.hIcon = NULL; - class.hCursor = NULL; - - if (!RegisterClass(&class)) { + 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"); } } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index a001816..7e7291d 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -402,7 +402,7 @@ PipeCheckProc( if (needEvent) { infoPtr->flags |= PIPE_PENDING; - evPtr = ckalloc(sizeof(PipeEvent)); + evPtr = (PipeEvent *)ckalloc(sizeof(PipeEvent)); evPtr->header.proc = PipeEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -433,7 +433,7 @@ TclWinMakeFile( { WinFile *filePtr; - filePtr = ckalloc(sizeof(WinFile)); + filePtr = (WinFile *)ckalloc(sizeof(WinFile)); filePtr->type = WIN_FILE; filePtr->handle = handle; @@ -1758,7 +1758,7 @@ TclpCreateCommandChannel( Tcl_Pid *pidPtr) /* An array of process identifiers. */ { char channelName[16 + TCL_INTEGER_SPACE]; - PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo)); + PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo)); PipeInit(); @@ -1912,7 +1912,7 @@ TclGetAndDetachPids( return; } - pipePtr = Tcl_GetChannelInstanceData(chan); + pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan); TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, pidsObj, @@ -2298,7 +2298,7 @@ PipeOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc(toWrite); + infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; @@ -2706,7 +2706,7 @@ TclWinAddProcess( void *hProcess, /* Handle to process */ unsigned long id) /* Global process identifier */ { - ProcInfo *procPtr = ckalloc(sizeof(ProcInfo)); + ProcInfo *procPtr = (ProcInfo*)ckalloc(sizeof(ProcInfo)); PipeInit(); @@ -2807,7 +2807,7 @@ WaitForRead( * or not. */ { DWORD timeout, count; - HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle; + HANDLE *handle = (HANDLE *)((WinFile *) infoPtr->readFile)->handle; while (1) { /* @@ -3279,9 +3279,9 @@ TclPipeThreadCreateTI( { TclPipeThreadInfo *pipeTI; #ifndef _PTI_USE_CKALLOC - pipeTI = malloc(sizeof(TclPipeThreadInfo)); + pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo)); #else - pipeTI = ckalloc(sizeof(TclPipeThreadInfo)); + pipeTI = (TclPipeThreadInfo *)ckalloc(sizeof(TclPipeThreadInfo)); #endif /* !_PTI_USE_CKALLOC */ pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL); pipeTI->state = PTI_STATE_IDLE; diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 943f1ca..3f8b546 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -14,7 +14,12 @@ #ifndef _TCLWINPORT #define _TCLWINPORT -#if !defined(_WIN64) && defined(BUILD_tcl) +/* define _USE_64BIT_TIME_T (or make/configure option time64bit) to force 64-bit time_t */ +#if defined(_USE_64BIT_TIME_T) +#define __MINGW_USE_VC2005_COMPAT +#endif + +#if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) && defined(BUILD_tcl) /* See [Bug 3354324]: file mtime sets wrong time */ # define _USE_32BIT_TIME_T #endif diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 5f131d3..b95cbcd 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -13,6 +13,8 @@ */ #undef STATIC_BUILD +#undef TCL_UTF_MAX +#define TCL_UTF_MAX 3 #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif @@ -116,7 +118,7 @@ static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, - const TCHAR * pKeyName, REGSAM mode); + const WCHAR * pKeyName, REGSAM mode); static int RegistryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -168,7 +170,7 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } @@ -415,7 +417,7 @@ DeleteKey( REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; - const TCHAR *nativeTail; + const WCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; Tcl_DString buf; @@ -468,7 +470,8 @@ DeleteKey( * Now we recursively delete the key and everything below it. */ - nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); + Tcl_DStringInit(&buf); + nativeTail = (const WCHAR *)Tcl_UtfToUniCharDString(tail, -1, &buf); result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); @@ -524,8 +527,9 @@ DeleteValue( } valueName = Tcl_GetString(valueNameObj); - Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds); - result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); + Tcl_DStringInit(&ds); + Tcl_UtfToUniCharDString(valueName, valueNameObj->length, &ds); + result = RegDeleteValue(key, (const WCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -568,7 +572,7 @@ GetKeyNames( { const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - TCHAR buffer[MAX_KEY_LENGTH]; + WCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ @@ -613,7 +617,8 @@ GetKeyNames( } break; } - name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); + Tcl_DStringInit(&ds); + name = Tcl_UniCharToUtfDString((const Tcl_UniChar *)buffer, bufSize, &ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); continue; @@ -663,7 +668,7 @@ GetType( DWORD result, type; Tcl_DString ds; const char *valueName; - const TCHAR *nativeValue; + const WCHAR *nativeValue; /* * Attempt to open the key for reading. @@ -679,7 +684,8 @@ GetType( */ valueName = Tcl_GetString(valueNameObj); - nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds); + Tcl_DStringInit(&ds); + nativeValue = (const WCHAR *)Tcl_UtfToUniCharDString(valueName, valueNameObj->length, &ds); result = RegQueryValueEx(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); @@ -732,7 +738,7 @@ GetValue( { HKEY key; const char *valueName; - const TCHAR *nativeValue; + const WCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; @@ -757,10 +763,11 @@ GetValue( Tcl_DStringInit(&data); Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); - length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; + length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1; valueName = Tcl_GetString(valueNameObj); - nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf); + Tcl_DStringInit(&buf); + nativeValue = (const WCHAR *)Tcl_UtfToUniCharDString(valueName, valueNameObj->length, &buf); result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); @@ -771,8 +778,8 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); - Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); + 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); } @@ -809,13 +816,13 @@ GetValue( */ while ((p < end) && *((WCHAR *) p) != 0) { - WCHAR *wp; + WCHAR *wp = (WCHAR *) p; - Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); + Tcl_DStringInit(&buf); + Tcl_UniCharToUtfDString((const Tcl_UniChar *)wp, wcslen(wp), &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - wp = (WCHAR *) p; while (*wp++ != 0) {/* empty body */} p = (char *) wp; @@ -823,7 +830,9 @@ GetValue( } Tcl_SetObjResult(interp, resultPtr); } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf); + WCHAR *wp = (WCHAR *) Tcl_DStringValue(&data); + Tcl_DStringInit(&buf); + Tcl_UniCharToUtfDString((const Tcl_UniChar *)Tcl_DStringValue(&data), wcslen(wp), &buf); Tcl_DStringResult(interp, &buf); } else { /* @@ -880,7 +889,7 @@ GetValueNames( resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); index = 0; result = TCL_OK; @@ -897,12 +906,11 @@ GetValueNames( */ size = MAX_KEY_LENGTH; - while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), + while (RegEnumValue(key,index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - size *= sizeof(TCHAR); - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, - &ds); + Tcl_DStringInit(&ds); + Tcl_UniCharToUtfDString((const Tcl_UniChar *)Tcl_DStringValue(&buffer), size, &ds); name = Tcl_DStringValue(&ds); if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, @@ -1008,8 +1016,9 @@ OpenSubKey( */ if (hostName) { - hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf); - result = RegConnectRegistry((TCHAR *)hostName, rootKey, + Tcl_DStringInit(&buf); + hostName = (char *) Tcl_UtfToUniCharDString(hostName, -1, &buf); + result = RegConnectRegistry((WCHAR *)hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { @@ -1023,12 +1032,13 @@ OpenSubKey( */ if (keyName) { - keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); + Tcl_DStringInit(&buf); + keyName = (char *) Tcl_UtfToUniCharDString(keyName, -1, &buf); } if (flags & REG_CREATE) { DWORD create; - result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL, + result = RegCreateKeyEx(rootKey, (WCHAR *)keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* @@ -1039,7 +1049,7 @@ OpenSubKey( *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { - result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode, + result = RegOpenKeyEx(rootKey, (WCHAR *)keyName, 0, mode, keyPtr); } if (keyName) { @@ -1159,7 +1169,7 @@ ParseKeyName( static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - const TCHAR *keyName, /* Name of key to be deleted in external + const WCHAR *keyName, /* Name of key to be deleted in external * encoding, not UTF. */ REGSAM mode) /* Mode flags to pass. */ { @@ -1185,7 +1195,7 @@ RecursiveDeleteKey( } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { @@ -1194,7 +1204,7 @@ RecursiveDeleteKey( */ size = MAX_KEY_LENGTH; - result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey), + result = RegEnumKeyEx(hKey, 0, (WCHAR *)Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { /* @@ -1219,7 +1229,7 @@ RecursiveDeleteKey( break; } else if (result == ERROR_SUCCESS) { result = RecursiveDeleteKey(hKey, - (const TCHAR *) Tcl_DStringValue(&subkey), mode); + (const WCHAR *) Tcl_DStringValue(&subkey), mode); } } Tcl_DStringFree(&subkey); @@ -1275,7 +1285,8 @@ SetValue( } valueName = Tcl_GetString(valueNameObj); - valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf); + Tcl_DStringInit(&nameBuf); + valueName = (char *) Tcl_UtfToUniCharDString(valueName, valueNameObj->length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; @@ -1287,7 +1298,7 @@ SetValue( } value = ConvertDWORD((DWORD) type, (DWORD) value); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueEx(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; @@ -1319,9 +1330,10 @@ SetValue( Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } - Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, + Tcl_DStringInit(&buf); + Tcl_UtfToUniCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueEx(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); @@ -1330,7 +1342,8 @@ SetValue( Tcl_DString buf; const char *data = Tcl_GetString(dataObj); - data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf); + Tcl_DStringInit(&buf); + data = (char *) Tcl_UtfToUniCharDString(data, dataObj->length, &buf); /* * Include the null in the length, padding if needed for WCHAR. @@ -1338,7 +1351,7 @@ SetValue( Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueEx(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); } else { @@ -1350,7 +1363,7 @@ SetValue( */ data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueEx(key, (WCHAR *) valueName, 0, (DWORD) type, data, (DWORD) bytelength); } @@ -1410,7 +1423,8 @@ BroadcastValue( } str = Tcl_GetString(objv[0]); - wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds); + Tcl_DStringInit(&ds); + wstr = (WCHAR *) Tcl_UtfToUniCharDString(str, objv[0]->length, &ds); if (Tcl_DStringLength(&ds) == 0) { wstr = NULL; } @@ -1454,7 +1468,7 @@ AppendSystemError( DWORD error) /* Result code from error. */ { int length; - TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; + WCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; @@ -1465,7 +1479,7 @@ AppendSystemError( } length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr, 0, NULL); if (length == 0) { sprintf(msgBuf, "unknown error: %ld", error); @@ -1473,7 +1487,8 @@ AppendSystemError( } else { char *msgPtr; - Tcl_WinTCharToUtf(tMsgPtr, -1, &ds); + Tcl_DStringInit(&ds); + Tcl_UniCharToUtfDString((const Tcl_UniChar *)tMsgPtr, wcslen(tMsgPtr), &ds); LocalFree(tMsgPtr); msgPtr = Tcl_DStringValue(&ds); diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 934ee0e..3a03259 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -400,6 +400,10 @@ SerialGetMilliseconds(void) *---------------------------------------------------------------------- */ +#ifdef __cplusplus +#define min(a, b) (((a) < (b)) ? (a) : (b)) +#endif + void SerialSetupProc( ClientData data, /* Not used. */ @@ -531,7 +535,7 @@ SerialCheckProc( if (needEvent) { infoPtr->flags |= SERIAL_PENDING; - evPtr = ckalloc(sizeof(SerialEvent)); + evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent)); evPtr->header.proc = SerialEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -1030,7 +1034,7 @@ SerialOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc(toWrite); + infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; @@ -1447,7 +1451,7 @@ TclWinOpenSerialChannel( SerialInit(); - infoPtr = ckalloc(sizeof(SerialInfo)); + infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); infoPtr->validMask = permissions; diff --git a/win/tclWinSock.c b/win/tclWinSock.c index d52edc3..bf01de2 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -397,7 +397,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = ckalloc(*lengthPtr + 1); + *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); Tcl_DStringFree(&ds); } @@ -489,7 +489,7 @@ TclpHasSockets( void TclpFinalizeSockets(void) { - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Careful! This is a finalizer! @@ -550,7 +550,7 @@ TcpBlockModeProc( * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; if (mode == TCL_MODE_NONBLOCKING) { SET_BITS(statePtr->flags, TCP_NONBLOCKING); @@ -646,10 +646,10 @@ WaitForConnect( while (1) { /* - * Get the statePtr lock. - */ + * Get the statePtr lock. + */ - tsdPtr = TclThreadDataKeyGet(&dataKey); + tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* @@ -783,10 +783,10 @@ TcpInputProc( * buffer? */ int *errorCodePtr) /* Where to store error code. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int bytesRead; DWORD error; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -926,10 +926,10 @@ TcpOutputProc( int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int written; DWORD error; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -1040,7 +1040,7 @@ TcpCloseProc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp) /* Unused. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; /* TIP #218 */ int errorCode = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -1135,7 +1135,7 @@ TcpClose2Proc( Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int errorCode = 0; int sd; @@ -1300,7 +1300,7 @@ TcpGetOptionProc( Tcl_DString *dsPtr) /* Where to store the computed value; * initialized by caller. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; char host[NI_MAXHOST], port[NI_MAXSERV]; SOCKET sock; size_t len = 0; @@ -1619,7 +1619,7 @@ TcpWatchProc( * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; /* * Update the watch events mask. Only if the socket is not a server @@ -1673,7 +1673,7 @@ TcpGetHandleProc( int direction, /* Not used. */ ClientData *handlePtr) /* Where to store the handle. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; *handlePtr = INT2PTR(statePtr->sockets->fd); return TCL_OK; @@ -1730,7 +1730,7 @@ TcpConnect( int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); /* We were called by the event procedure and * continue our loop. */ - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (async_callback) { goto reenter; @@ -2149,7 +2149,7 @@ Tcl_MakeTcpClientChannel( return NULL; } - tsdPtr = TclThreadDataKeyGet(&dataKey); + tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Set kernel space buffering and non-blocking. @@ -2341,7 +2341,7 @@ Tcl_OpenTcpServerEx( } if (statePtr != NULL) { - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; @@ -2409,7 +2409,7 @@ TcpAccept( int len = sizeof(addr); char channelName[SOCK_CHAN_LENGTH]; char host[NI_MAXHOST], port[NI_MAXSERV]; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Win-NT has a misfeature that sockets are inherited in child processes @@ -2480,7 +2480,7 @@ static void InitSockets(void) { DWORD id; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (!initialized) { initialized = 1; @@ -2722,7 +2722,7 @@ SocketCheckProc( statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); - evPtr = ckalloc(sizeof(SocketEvent)); + evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -2997,7 +2997,7 @@ AddSocketInfoFd( * Add the first FD. */ - statePtr->sockets = ckalloc(sizeof(TcpFdList)); + statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { /* @@ -3008,7 +3008,7 @@ AddSocketInfoFd( fds = fds->next; } - fds->next = ckalloc(sizeof(TcpFdList)); + fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList)); fds = fds->next; } @@ -3041,7 +3041,7 @@ AddSocketInfoFd( static TcpState * NewSocketInfo(SOCKET socket) { - TcpState *statePtr = ckalloc(sizeof(TcpState)); + TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); @@ -3084,7 +3084,7 @@ WaitForSocketEvent( { int result = 1; int oldMode; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Be sure to disable event servicing so we are truly modal. @@ -3170,7 +3170,7 @@ SocketThread( LPVOID arg) { MSG msg; - ThreadSpecificData *tsdPtr = arg; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)arg; /* * Create a dummy window receiving socket events. @@ -3485,7 +3485,7 @@ TcpThreadActionProc( int action) { ThreadSpecificData *tsdPtr; - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 1cff8e9..1a1ed12 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -41,6 +41,8 @@ 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, @@ -78,6 +80,7 @@ TclplatformtestInit( 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; } @@ -310,6 +313,26 @@ TestwinsleepCmd( 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; + } + +syntax: + Tcl_WrongNumArgs(interp, 1, objv, "time_t"); + return TCL_ERROR; +} + /* *---------------------------------------------------------------------- * diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index d169ebb..c0d489b 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -568,7 +568,7 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = ckalloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); @@ -711,7 +711,7 @@ Tcl_ConditionWait( */ if (*condPtr == NULL) { - winCondPtr = ckalloc(sizeof(WinCondition)); + winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; @@ -940,7 +940,7 @@ TclpNewAllocMutex(void) { allocMutex *lockPtr; - lockPtr = malloc(sizeof(allocMutex)); + lockPtr = (allocMutex *)malloc(sizeof(allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } @@ -1037,7 +1037,7 @@ TclpThreadCreateKey(void) { DWORD *key; - key = TclpSysAlloc(sizeof *key, 0); + key = (DWORD *)TclpSysAlloc(sizeof *key, 0); if (key == NULL) { Tcl_Panic("unable to allocate thread key!"); } @@ -1055,7 +1055,7 @@ void TclpThreadDeleteKey( void *keyPtr) { - DWORD *key = keyPtr; + DWORD *key = (DWORD *)keyPtr; if (!TlsFree(*key)) { Tcl_Panic("unable to delete key"); @@ -1069,7 +1069,7 @@ TclpThreadSetMasterTSD( void *tsdKeyPtr, void *ptr) { - DWORD *key = tsdKeyPtr; + DWORD *key = (DWORD *)tsdKeyPtr; if (!TlsSetValue(*key, ptr)) { Tcl_Panic("unable to set master TSD value"); @@ -1080,7 +1080,7 @@ void * TclpThreadGetMasterTSD( void *tsdKeyPtr) { - DWORD *key = tsdKeyPtr; + DWORD *key = (DWORD *)tsdKeyPtr; return TlsGetValue(*key); } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index bfebbe6..5890ce5 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -98,7 +98,7 @@ static TimeInfo timeInfo = { (HANDLE) NULL, (HANDLE) NULL, (HANDLE) NULL, -#ifdef HAVE_CAST_TO_UNION +#if defined(HAVE_CAST_TO_UNION) && !defined(__cplusplus) (LARGE_INTEGER) (Tcl_WideInt) 0, (ULARGE_INTEGER) (DWORDLONG) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, @@ -124,7 +124,7 @@ 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}; +} wideClick = {0, 0, 0.0}; /* |