From 84a0e0855774706c583d76f14ca462d5bbf1b42e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 26 Mar 2023 15:51:21 +0000 Subject: Patch from chrstphrchvz, fixing [d40b9c8503]. Many thanks! --- unix/configure | 119 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ unix/tcl.m4 | 27 ++++++++++++- 2 files changed, 144 insertions(+), 2 deletions(-) diff --git a/unix/configure b/unix/configure index 4c54fbe..e33a196 100755 --- a/unix/configure +++ b/unix/configure @@ -7631,6 +7631,56 @@ printf "%s\n" "#define _LARGEFILE64_SOURCE 1" >>confdefs.h tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" fi + + if test ${tcl_cv_flag__file_offset_bits+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; } + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + tcl_cv_flag__file_offset_bits=no +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _FILE_OFFSET_BITS 64 +#include +int +main (void) +{ +switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; } + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + tcl_cv_flag__file_offset_bits=yes +else $as_nop + tcl_cv_flag__file_offset_bits=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + if test "x${tcl_cv_flag__file_offset_bits}" = "xyes" ; then + +printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h + + tcl_flags="$tcl_flags _FILE_OFFSET_BITS" + fi + if test "x${tcl_flags}" = "x" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none" >&5 printf "%s\n" "none" >&6; } @@ -7682,6 +7732,75 @@ printf "%s\n" "yes" >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } # Now check for auxiliary declarations + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for 64-bit time_t" >&5 +printf %s "checking for 64-bit time_t... " >&6; } +if test ${tcl_cv_time_t_64+y} +then : + printf %s "(cached) " >&6 +else $as_nop + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +switch (0) {case 0: case (sizeof(time_t)==sizeof(long long)): ;} + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + tcl_cv_time_t_64=yes +else $as_nop + tcl_cv_time_t_64=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_time_t_64" >&5 +printf "%s\n" "$tcl_cv_time_t_64" >&6; } + if test "x${tcl_cv_time_t_64}" = "xno" ; then + # Note that _TIME_BITS=64 requires _FILE_OFFSET_BITS=64 + # which SC_TCL_EARLY_FLAGS has defined if necessary. + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if _TIME_BITS=64 enables 64-bit time_t" >&5 +printf %s "checking if _TIME_BITS=64 enables 64-bit time_t... " >&6; } +if test ${tcl_cv__time_bits+y} +then : + printf %s "(cached) " >&6 +else $as_nop + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _TIME_BITS 64 +#include +int +main (void) +{ +switch (0) {case 0: case (sizeof(time_t)==sizeof(long long)): ;} + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + tcl_cv__time_bits=yes +else $as_nop + tcl_cv__time_bits=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv__time_bits" >&5 +printf "%s\n" "$tcl_cv__time_bits" >&6; } + if test "x${tcl_cv__time_bits}" = "xyes" ; then + +printf "%s\n" "#define _TIME_BITS 64" >>confdefs.h + + else + as_fn_error $? "no 64-bit time_t available" "$LINENO" 5 + fi + fi + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5 printf %s "checking for struct dirent64... " >&6; } if test ${tcl_cv_struct_dirent64+y} diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 5ac917c..947a1e1 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2329,18 +2329,19 @@ AC_DEFUN([SC_TCL_LINK_LIBS], [ # Might define the following vars: # _ISOC99_SOURCE # _LARGEFILE64_SOURCE +# _FILE_OFFSET_BITS # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_EARLY_FLAG],[ AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[$2]], [[$3]])], - [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[[#define ]$1[ 1 + [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[[#define ]$1[ ]m4_default([$4],[1])[ ]$2]], [[$3]])], [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no)])) if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then - AC_DEFINE($1, 1, [Add the ]$1[ flag when building]) + AC_DEFINE($1, m4_default([$4],[1]), [Add the ]$1[ flag when building]) tcl_flags="$tcl_flags $1" fi ]) @@ -2352,6 +2353,8 @@ AC_DEFUN([SC_TCL_EARLY_FLAGS],[ [char *p = (char *)strtoll; char *q = (char *)strtoull;]) SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include ], [struct stat64 buf; int i = stat64("/", &buf);]) + SC_TCL_EARLY_FLAG(_FILE_OFFSET_BITS,[#include ], + [switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; }],64) if test "x${tcl_flags}" = "x" ; then AC_MSG_RESULT([none]) else @@ -2374,6 +2377,7 @@ AC_DEFUN([SC_TCL_EARLY_FLAGS],[ # HAVE_STRUCT_DIRENT64, HAVE_DIR64 # HAVE_STRUCT_STAT64 # HAVE_TYPE_OFF64_T +# _TIME_BITS # #-------------------------------------------------------------------- @@ -2393,6 +2397,25 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [ else AC_MSG_RESULT([no]) # Now check for auxiliary declarations + AC_CACHE_CHECK([for 64-bit time_t], tcl_cv_time_t_64,[ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], + [[switch (0) {case 0: case (sizeof(time_t)==sizeof(long long)): ;}]])], + [tcl_cv_time_t_64=yes],[tcl_cv_time_t_64=no])]) + if test "x${tcl_cv_time_t_64}" = "xno" ; then + # Note that _TIME_BITS=64 requires _FILE_OFFSET_BITS=64 + # which SC_TCL_EARLY_FLAGS has defined if necessary. + AC_CACHE_CHECK([if _TIME_BITS=64 enables 64-bit time_t], tcl_cv__time_bits,[ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#define _TIME_BITS 64 +#include ]], + [[switch (0) {case 0: case (sizeof(time_t)==sizeof(long long)): ;}]])], + [tcl_cv__time_bits=yes],[tcl_cv__time_bits=no])]) + if test "x${tcl_cv__time_bits}" = "xyes" ; then + AC_DEFINE(_TIME_BITS, 64, [_TIME_BITS=64 enables 64-bit time_t.]) + else + AC_MSG_ERROR([no 64-bit time_t available]) + fi + fi + AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[struct dirent64 p;]])], -- cgit v0.12 From 72db4a5deb729d32c1bdf08df9836f11e0c13f25 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 20 Jul 2023 12:41:32 +0000 Subject: Don't bail out when no 64-bit time is available --- unix/configure | 2 -- unix/tcl.m4 | 2 -- 2 files changed, 4 deletions(-) diff --git a/unix/configure b/unix/configure index 0c01d10..44265f2 100755 --- a/unix/configure +++ b/unix/configure @@ -7706,8 +7706,6 @@ printf "%s\n" "$tcl_cv__time_bits" >&6; } printf "%s\n" "#define _TIME_BITS 64" >>confdefs.h - else - as_fn_error $? "no 64-bit time_t available" "$LINENO" 5 fi fi diff --git a/unix/tcl.m4 b/unix/tcl.m4 index d1eeed3..98581e8 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2377,8 +2377,6 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [ [tcl_cv__time_bits=yes],[tcl_cv__time_bits=no])]) if test "x${tcl_cv__time_bits}" = "xyes" ; then AC_DEFINE(_TIME_BITS, 64, [_TIME_BITS=64 enables 64-bit time_t.]) - else - AC_MSG_ERROR([no 64-bit time_t available]) fi fi -- cgit v0.12 From 6a7b44b23cd1a7638b549891994cd117583870c1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 20 Jul 2023 13:07:41 +0000 Subject: .... forgot to re-generate tclConfig.h.in --- unix/tclConfig.h.in | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index fe2c6d9..a1b59df 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -471,6 +471,9 @@ /* Are Darwin SUSv3 extensions available? */ #undef _DARWIN_C_SOURCE +/* Add the _FILE_OFFSET_BITS flag when building */ +#undef _FILE_OFFSET_BITS + /* Add the _ISOC99_SOURCE flag when building */ #undef _ISOC99_SOURCE @@ -489,6 +492,9 @@ /* Do we want the thread-safe OS API? */ #undef _THREAD_SAFE +/* _TIME_BITS=64 enables 64-bit time_t. */ +#undef _TIME_BITS + /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE -- cgit v0.12 From 041458aca6de0fe6531a06a97e49219747775266 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 20 Jul 2023 13:32:47 +0000 Subject: Add comment to cmdAH-24.20.[12] --- tests/cmdAH.test | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 555c70f..ad5a67d 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -1710,6 +1710,8 @@ test cmdAH-24.14.1 { test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setup { set filename [makeFile "" foo.text] } -body { + # This test may fail if your system does not have a 64-bit time_t. + # That is to be expected and is not a problem with Tcl. list [file atime $filename 3155760000] [file atime $filename] } -cleanup { removeFile $filename @@ -1717,6 +1719,8 @@ test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setu test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -setup { set filename [makeFile "" foo.text] } -body { + # This test may fail if your system does not have a 64-bit time_t. + # That is to be expected and is not a problem with Tcl. list [file mtime $filename 3155760000] [file mtime $filename] } -cleanup { file delete -force $filename -- cgit v0.12 From 9195d0b1bc6a7d80e16f86172efd83c4cb73919b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 20 Jul 2023 20:52:03 +0000 Subject: Fix handling of pre-built libtommath.dll on win64-arm --- win/Makefile.in | 10 +++++++--- win/tclWinPipe.c | 4 ++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index e702c3e..75c34cb 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -614,10 +614,14 @@ ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} # use pre-built libtommath.dll ${TOMMATH_DLL_FILE}: ${TCL_STUB_LIB_FILE} - @if test "@TOMMATH_LIBS@set" != "${TOMMATH_DIR_NATIVE}/win32/tommath.libset" ; then \ - $(COPY) $(TOMMATH_DIR)/win64/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ - else \ + @if test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win64-arm/tommath.libset" ; then \ + $(COPY) $(TOMMATH_DIR)/win64-arm/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ + elif test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.aset" ; then \ + $(COPY) $(TOMMATH_DIR)/win64-arm/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ + elif test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win32/tommath.libset" ; then \ $(COPY) $(TOMMATH_DIR)/win32/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ + else \ + $(COPY) $(TOMMATH_DIR)/win64/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ fi; # Add the object extension to the implicit rules. By default .obj is not diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 048f0e8..cb6177c 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -869,7 +869,7 @@ TclpGetPid( Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == PTR2INT(pid)) { + if (infoPtr->dwProcessId == PTR2UINT(pid)) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } @@ -2565,7 +2565,7 @@ Tcl_WaitPid( prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == PTR2INT(pid)) { + if (infoPtr->dwProcessId == PTR2UINT(pid)) { *prevPtrPtr = infoPtr->nextPtr; break; } -- cgit v0.12 From a22f4cc1673d6d079ba1d411750383b258a3b709 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 21 Jul 2023 07:11:25 +0000 Subject: Check for _LARGEFILE64_SOURCE after _FILE_OFFSET_BITS=64, since the latter is prefered --- unix/configure | 40 ++++++++++++++++++++-------------------- unix/tcl.m4 | 6 +++--- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/unix/configure b/unix/configure index 44265f2..66af4ce 100755 --- a/unix/configure +++ b/unix/configure @@ -7492,7 +7492,7 @@ printf "%s\n" "#define _ISOC99_SOURCE 1" >>confdefs.h fi - if test ${tcl_cv_flag__largefile64_source+y} + if test ${tcl_cv_flag__file_offset_bits+y} then : printf %s "(cached) " >&6 else $as_nop @@ -7502,47 +7502,47 @@ else $as_nop int main (void) { -struct stat64 buf; int i = stat64("/", &buf); +switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; } ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : - tcl_cv_flag__largefile64_source=no + tcl_cv_flag__file_offset_bits=no else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#define _LARGEFILE64_SOURCE 1 +#define _FILE_OFFSET_BITS 64 #include int main (void) { -struct stat64 buf; int i = stat64("/", &buf); +switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; } ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : - tcl_cv_flag__largefile64_source=yes + tcl_cv_flag__file_offset_bits=yes else $as_nop - tcl_cv_flag__largefile64_source=no + tcl_cv_flag__file_offset_bits=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi - if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then + if test "x${tcl_cv_flag__file_offset_bits}" = "xyes" ; then -printf "%s\n" "#define _LARGEFILE64_SOURCE 1" >>confdefs.h +printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h - tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" + tcl_flags="$tcl_flags _FILE_OFFSET_BITS" fi - if test ${tcl_cv_flag__file_offset_bits+y} + if test ${tcl_cv_flag__largefile64_source+y} then : printf %s "(cached) " >&6 else $as_nop @@ -7552,43 +7552,43 @@ else $as_nop int main (void) { -switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; } +struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : - tcl_cv_flag__file_offset_bits=no + tcl_cv_flag__largefile64_source=no else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#define _FILE_OFFSET_BITS 64 +#define _LARGEFILE64_SOURCE 1 #include int main (void) { -switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; } +struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : - tcl_cv_flag__file_offset_bits=yes + tcl_cv_flag__largefile64_source=yes else $as_nop - tcl_cv_flag__file_offset_bits=no + tcl_cv_flag__largefile64_source=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi - if test "x${tcl_cv_flag__file_offset_bits}" = "xyes" ; then + if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then -printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h +printf "%s\n" "#define _LARGEFILE64_SOURCE 1" >>confdefs.h - tcl_flags="$tcl_flags _FILE_OFFSET_BITS" + tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" fi if test "x${tcl_flags}" = "x" ; then diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 98581e8..beaac7e 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2294,8 +2294,8 @@ AC_DEFUN([SC_TCL_LINK_LIBS], [ # # Might define the following vars: # _ISOC99_SOURCE -# _LARGEFILE64_SOURCE # _FILE_OFFSET_BITS +# _LARGEFILE64_SOURCE # #-------------------------------------------------------------------- @@ -2317,10 +2317,10 @@ AC_DEFUN([SC_TCL_EARLY_FLAGS],[ tcl_flags="" SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include ], [char *p = (char *)strtoll; char *q = (char *)strtoull;]) - SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include ], - [struct stat64 buf; int i = stat64("/", &buf);]) SC_TCL_EARLY_FLAG(_FILE_OFFSET_BITS,[#include ], [switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; }],64) + SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include ], + [struct stat64 buf; int i = stat64("/", &buf);]) if test "x${tcl_flags}" = "x" ; then AC_MSG_RESULT([none]) else -- cgit v0.12 From 7caf2af1db913adaf775172aaa508e3b98274967 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 21 Jul 2023 11:37:21 +0000 Subject: simplify tenviron2utfdstr/utf2tenvirondstr macro's, since 2nd argument is always -1 Improve error-handling related to environment variables All 'stolen' from TIP #571 branch --- generic/tclEnv.c | 91 +++++++++++++++++++++++++++++++++----------------------- win/tclWinInit.c | 3 -- 2 files changed, 53 insertions(+), 41 deletions(-) diff --git a/generic/tclEnv.c b/generic/tclEnv.c index e9da69f..ef5cfb7 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -19,20 +19,20 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) # define tenviron _wenviron -# define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ - (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))) -# define utf2tenvirondstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ - (const WCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr))) +# define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) +# define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ + (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) # define techar WCHAR # ifdef USE_PUTENV # define putenv(env) _wputenv((const wchar_t *)env) # endif #else # define tenviron environ -# define tenviron2utfdstr(tenvstr, len, dstr) \ - Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr) -# define utf2tenvirondstr(str, len, dstr) \ - Tcl_UtfToExternalDString(NULL, str, len, dstr) +# define tenviron2utfdstr(str, dsPtr) \ + Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) +# define utf2tenvirondstr(str, dsPtr) \ + Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) # define techar char #endif @@ -42,7 +42,7 @@ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ static struct { - int cacheSize; /* Number of env strings in cache. */ + Tcl_Size cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV @@ -50,7 +50,7 @@ static struct { * need to track this in case another * subsystem swaps around the environ array * like we do. */ - int ourEnvironSize; /* Non-zero means that the environ array was + Tcl_Size ourEnvironSize; /* Non-zero means that the environ array was * malloced and has this many total entries * allocated to it (not all may be in use at * once). Zero means that the environment @@ -64,7 +64,7 @@ static struct { * Declarations for local functions defined in this file: */ -static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp, +static char * EnvTraceProc(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void ReplaceString(const char *oldStr, char *newStr); MODULE_SCOPE void TclSetEnv(const char *name, const char *value); @@ -159,7 +159,11 @@ TclSetupEnv( const char *p1; char *p2; - p1 = tenviron2utfdstr(tenviron[i], -1, &envString); + p1 = tenviron2utfdstr(tenviron[i], &envString); + if (p1 == NULL) { + /* Ignore what cannot be decoded (should not happen) */ + continue; + } p2 = (char *)strchr(p1, '='); if (p2 == NULL) { /* @@ -253,8 +257,8 @@ TclSetEnv( const char *value) /* New value for variable (UTF-8). */ { Tcl_DString envString; - unsigned nameLength, valueLength; - int index, length; + Tcl_Size nameLength, valueLength; + Tcl_Size index, length; char *p, *oldValue; const techar *p2; @@ -267,7 +271,7 @@ TclSetEnv( Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); - if (index == -1) { + if (index == TCL_INDEX_NONE) { #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed @@ -301,9 +305,9 @@ TclSetEnv( * interpreters. */ - oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString); - if (strcmp(value, oldEnv + (length + 1)) == 0) { - Tcl_DStringFree(&envString); + oldEnv = tenviron2utfdstr(tenviron[index], &envString); + if (oldEnv == NULL || strcmp(value, oldEnv + (length + 1)) == 0) { + Tcl_DStringFree(&envString); /* OK even if oldEnv is NULL */ Tcl_MutexUnlock(&envMutex); return; } @@ -324,7 +328,13 @@ TclSetEnv( memcpy(p, name, nameLength); p[nameLength] = '='; memcpy(p+nameLength+1, value, valueLength+1); - p2 = utf2tenvirondstr(p, -1, &envString); + p2 = utf2tenvirondstr(p, &envString); + if (p2 == NULL) { + /* No way to signal error from here :-( but should not happen */ + ckfree(p); + Tcl_MutexUnlock(&envMutex); + return; + } /* * Copy the native string to heap memory. @@ -351,7 +361,7 @@ TclSetEnv( * string in the cache. */ - if ((index != -1) && (tenviron[index] == (techar *)p)) { + if ((index != TCL_INDEX_NONE) && (tenviron[index] == (techar *)p)) { ReplaceString(oldValue, p); #ifdef HAVE_PUTENV_THAT_COPIES } else { @@ -415,7 +425,7 @@ Tcl_PutEnv( * name and value parts, and call TclSetEnv to do all of the real work. */ - name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString); + name = Tcl_ExternalToUtfDString(NULL, assignment, TCL_INDEX_NONE, &nameString); value = (char *)strchr(name, '='); if ((value != NULL) && (value != name)) { @@ -462,8 +472,7 @@ TclUnsetEnv( const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; - int length; - int index; + Tcl_Size length, index; #ifdef USE_PUTENV_FOR_UNSET Tcl_DString envString; char *string; @@ -512,7 +521,11 @@ TclUnsetEnv( string[length] = '\0'; #endif /* _WIN32 */ - utf2tenvirondstr(string, -1, &envString); + if (utf2tenvirondstr(string, &envString) == NULL) { + /* Should not happen except memory alloc fail. */ + Tcl_MutexUnlock(&envMutex); + return; + } string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + tNTL); memcpy(string, Tcl_DStringValue(&envString), Tcl_DStringLength(&envString) + tNTL); @@ -578,7 +591,7 @@ TclGetEnv( * value of the environment variable is * stored. */ { - int length, index; + Tcl_Size length, index; const char *result; Tcl_MutexLock(&envMutex); @@ -587,17 +600,19 @@ TclGetEnv( if (index != -1) { Tcl_DString envStr; - result = tenviron2utfdstr(tenviron[index], -1, &envStr); - result += length; - if (*result == '=') { - result++; - Tcl_DStringInit(valuePtr); - Tcl_DStringAppend(valuePtr, result, -1); - result = Tcl_DStringValue(valuePtr); - } else { - result = NULL; + result = tenviron2utfdstr(tenviron[index], &envStr); + if (result) { + result += length; + if (*result == '=') { + result++; + Tcl_DStringInit(valuePtr); + Tcl_DStringAppend(valuePtr, result, -1); + result = Tcl_DStringValue(valuePtr); + } else { + result = NULL; + } + Tcl_DStringFree(&envStr); } - Tcl_DStringFree(&envStr); } Tcl_MutexUnlock(&envMutex); return result; @@ -626,7 +641,7 @@ TclGetEnv( static char * EnvTraceProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter whose "env" variable is being * modified. */ const char *name1, /* Better be "env". */ @@ -713,7 +728,7 @@ ReplaceString( const char *oldStr, /* Old environment string. */ char *newStr) /* New environment string. */ { - int i; + Tcl_Size i; /* * Check to see if the old value was allocated by Tcl. If so, it needs to @@ -792,7 +807,7 @@ TclFinalizeEnvironment(void) if (env.cache) { #ifdef PURIFY - int i; + Tcl_Size i; for (i = 0; i < env.cacheSize; i++) { ckfree(env.cache[i]); } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 253acee..01714f0 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -579,9 +579,6 @@ TclpSetVariables( *---------------------------------------------------------------------- */ -# define tenviron2utfdstr(string, len, dsPtr) \ - (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)) - Tcl_Size TclpFindVariable( const char *name, /* Name of desired environment variable -- cgit v0.12