From 177528494062f82a82280977e5ea3129515cf955 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Sep 2018 20:30:20 +0000 Subject: Fix test-case registry-6.20, which started failing starting with the TIP #389 commit. --- generic/tclStubInit.c | 20 +++++++++++++++++--- win/tclWin32Dll.c | 18 ++++++++++++++++-- 2 files changed, 33 insertions(+), 5 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index bf3a8d1..36550ea 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -225,17 +225,31 @@ Tcl_WinUtfToTChar( int len, Tcl_DString *dsPtr) { - WCHAR *wp; + WCHAR *wp, *p; int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0); Tcl_DStringInit(dsPtr); Tcl_DStringSetLength(dsPtr, 2*size+2); - wp = (WCHAR *)Tcl_DStringValue(dsPtr); + p = wp = (WCHAR *)Tcl_DStringValue(dsPtr); MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1); if (len == -1) --size; /* account for 0-byte at string end */ + + /* It turns out that MultiByteToWideChar() cannot handle the 'modified' + * UTF-8 as used by Tcl. Every sequence of 0xC0 followed by 0x80 will + * be translated to two 0xfffd characters. This results in a test-failure + * of the registry-6.20 test-case. The simplest solution is to search for + * those two 0xfffd characters and replace them by a \u0000 character. */ + while (p < wp + size - 1) { + if (p[0] == 0xfffd && p[1] == 0xfffd) { + memmove(p+1, p+2, sizeof(WCHAR) * (p - wp + size - 2)); + p[0] = 0; + ++p; --size; + } + ++p; + } Tcl_DStringSetLength(dsPtr, 2*size); wp[size] = 0; - return (char *)wp; + return wp; } char * diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 74787c5..26da566 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -471,14 +471,28 @@ Tcl_WinUtfToTChar( Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { - TCHAR *wp; + TCHAR *wp, *p; int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0); Tcl_DStringInit(dsPtr); Tcl_DStringSetLength(dsPtr, 2*size+2); - wp = (TCHAR *)Tcl_DStringValue(dsPtr); + p = wp = (TCHAR *)Tcl_DStringValue(dsPtr); MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1); if (len == -1) --size; /* account for 0-byte at string end */ + + /* It turns out that MultiByteToWideChar() cannot handle the 'modified' + * UTF-8 as used by Tcl. Every sequence of 0xC0 followed by 0x80 will + * be translated to two 0xfffd characters. This results in a test-failure + * of the registry-6.20 test-case. The simplest solution is to search for + * those two 0xfffd characters and replace them by a \u0000 character. */ + while (p < wp + size - 1) { + if (p[0] == 0xfffd && p[1] == 0xfffd) { + memmove(p+1, p+2, sizeof(TCHAR) * (p - wp + size - 2)); + p[0] = 0; + ++p; --size; + } + ++p; + } Tcl_DStringSetLength(dsPtr, 2*size); wp[size] = 0; return wp; -- cgit v0.12 From f11320b6b0dd2681bef8470d4fcf7c3b7eb6cbbd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Sep 2018 20:31:45 +0000 Subject: Fix various test-cases, which started failing on Windows due to TIP #430 --- tests/env.test | 2 ++ tests/exec.test | 2 ++ tests/platform.test | 2 +- tests/thread.test | 7 +++++-- win/Makefile.in | 4 ++++ 5 files changed, 14 insertions(+), 3 deletions(-) diff --git a/tests/env.test b/tests/env.test index 59d5391..79a353a 100644 --- a/tests/env.test +++ b/tests/env.test @@ -16,6 +16,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] package require tcltests # [exec] is required here to see the actual environment received by child diff --git a/tests/exec.test b/tests/exec.test index dfc44c4..4fd8b8d 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -17,6 +17,8 @@ package require tcltest 2 namespace import -force ::tcltest::* +loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] package require tcltests # All tests require the "exec" command. diff --git a/tests/platform.test b/tests/platform.test index 5880fb9..53d534e 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -10,7 +10,6 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2 -package require tcltests namespace eval ::tcl::test::platform { namespace import ::tcltest::testConstraint @@ -23,6 +22,7 @@ namespace eval ::tcl::test::platform { ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] +package require tcltests testConstraint testCPUID [llength [info commands testcpuid]] testConstraint testlongsize [llength [info commands testlongsize]] diff --git a/tests/thread.test b/tests/thread.test index eaaaa41..2524911 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -11,14 +11,17 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. +if {"::tcltest" ni [namespace children]} { + package require tcltest 2 + namespace import -force ::tcltest::* +} # when thread::release is used, -wait is passed in order allow the thread to # be fully finalized, which avoids valgrind "still reachable" reports. -package require tcltests - ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] +package require tcltests # Some tests require the testthread command diff --git a/win/Makefile.in b/win/Makefile.in index 1d9c522..b5095e7 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -486,6 +486,8 @@ ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} rm -rf ${TCL_VFS_ROOT} mkdir -p ${TCL_VFS_PATH} $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH} + $(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde + $(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) @@ -864,6 +866,7 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \ package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) @@ -871,6 +874,7 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) runtest: binaries $(TCLSH) $(TEST_DLL_FILE) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \ package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) -- cgit v0.12 From c5943ec574403a010f3065a6d8fdb6d590e68de4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Sep 2018 20:33:58 +0000 Subject: Eliminate the use of macro's like LLONG_MAX|MIN, since they assume that Tcl_WideInt equals "long long". Also eliminate uses of Tcl_WideAsLong() and friends, as - often - simple type cases make things more clear. --- generic/tclIO.c | 34 +++++++++++++++++----------------- generic/tclIOCmd.c | 4 ++-- generic/tclIOGT.c | 13 ++++++------- generic/tclIORChan.c | 6 +++--- generic/tclIORTrans.c | 17 ++++++++--------- generic/tclIOUtil.c | 4 ++-- generic/tclObj.c | 4 ++-- generic/tclPort.h | 17 ++--------------- generic/tclStringObj.c | 2 +- generic/tclStubInit.c | 10 ++-------- generic/tclTest.c | 4 ++-- unix/tclUnixChan.c | 8 ++++---- win/tclWinChan.c | 10 +++++----- 13 files changed, 56 insertions(+), 77 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index ad6c7ee..10362d4 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -482,13 +482,13 @@ ChanSeek( offset, mode, errnoPtr); } - if (offsetTcl_LongAsWide(LONG_MAX)) { + if (offsetLONG_MAX) { *errnoPtr = EOVERFLOW; - return Tcl_LongAsWide(-1); + return -1; } - return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData, - Tcl_WideAsLong(offset), mode, errnoPtr)); + return chanPtr->typePtr->seekProc(chanPtr->instanceData, + offset, mode, errnoPtr); } static inline void @@ -6953,7 +6953,7 @@ Tcl_Seek( * non-blocking mode after the seek. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { - return Tcl_LongAsWide(-1); + return -1; } /* @@ -6964,7 +6964,7 @@ Tcl_Seek( */ if (CheckForDeadChannel(NULL, statePtr)) { - return Tcl_LongAsWide(-1); + return -1; } /* @@ -6980,7 +6980,7 @@ Tcl_Seek( if (chanPtr->typePtr->seekProc == NULL) { Tcl_SetErrno(EINVAL); - return Tcl_LongAsWide(-1); + return -1; } /* @@ -6993,7 +6993,7 @@ Tcl_Seek( if ((inputBuffered != 0) && (outputBuffered != 0)) { Tcl_SetErrno(EFAULT); - return Tcl_LongAsWide(-1); + return -1; } /* @@ -7036,7 +7036,7 @@ Tcl_Seek( wasAsync = 1; result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING); if (result != 0) { - return Tcl_LongAsWide(-1); + return -1; } ResetFlag(statePtr, CHANNEL_NONBLOCKING); if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { @@ -7061,7 +7061,7 @@ Tcl_Seek( */ curPos = ChanSeek(chanPtr, offset, mode, &result); - if (curPos == Tcl_LongAsWide(-1)) { + if (curPos == -1) { Tcl_SetErrno(result); } } @@ -7077,7 +7077,7 @@ Tcl_Seek( SetFlag(statePtr, CHANNEL_NONBLOCKING); result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING); if (result != 0) { - return Tcl_LongAsWide(-1); + return -1; } } @@ -7117,7 +7117,7 @@ Tcl_Tell( Tcl_WideInt curPos; /* Position on device. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { - return Tcl_LongAsWide(-1); + return -1; } /* @@ -7128,7 +7128,7 @@ Tcl_Tell( */ if (CheckForDeadChannel(NULL, statePtr)) { - return Tcl_LongAsWide(-1); + return -1; } /* @@ -7144,7 +7144,7 @@ Tcl_Tell( if (chanPtr->typePtr->seekProc == NULL) { Tcl_SetErrno(EINVAL); - return Tcl_LongAsWide(-1); + return -1; } /* @@ -7161,10 +7161,10 @@ Tcl_Tell( * wideSeekProc if that is available and non-NULL... */ - curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result); - if (curPos == Tcl_LongAsWide(-1)) { + curPos = ChanSeek(chanPtr, 0, SEEK_CUR, &result); + if (curPos == -1) { Tcl_SetErrno(result); - return Tcl_LongAsWide(-1); + return -1; } if (inputBuffered != 0) { diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 87bf415..d38240a 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -559,7 +559,7 @@ Tcl_SeekObjCmd( TclChannelPreserve(chan); result = Tcl_Seek(chan, offset, mode); - if (result == Tcl_LongAsWide(-1)) { + if (result == -1) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and @@ -1913,7 +1913,7 @@ ChanTruncateObjCmd( */ length = Tcl_Tell(chan); - if (length == Tcl_WideAsLong(-1)) { + if (length == -1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not determine current location in \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index c1e8c44..9949a0e 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -910,7 +910,7 @@ TransformWideSeekProc( Tcl_ChannelWideSeekProc(parentType); ClientData parentData = Tcl_GetChannelInstanceData(parent); - if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) { + if ((offset == 0) && (mode == SEEK_CUR)) { /* * This is no seek but a request to tell the caller the current * location. Simply pass the request down. @@ -920,8 +920,7 @@ TransformWideSeekProc( return parentWideSeekProc(parentData, offset, mode, errorCodePtr); } - return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode, - errorCodePtr)); + return parentSeekProc(parentData, 0, mode, errorCodePtr); } /* @@ -961,13 +960,13 @@ TransformWideSeekProc( * to go out of the representable range. */ - if (offsetTcl_LongAsWide(LONG_MAX)) { + if (offsetLONG_MAX) { *errorCodePtr = EOVERFLOW; - return Tcl_LongAsWide(-1); + return -1; } - return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset), - mode, errorCodePtr)); + return parentSeekProc(parentData, offset, + mode, errorCodePtr); } /* diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 354f1fb..611ee3f 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -1544,7 +1544,7 @@ ReflectSeekWide( goto invalid; } - if (newLoc < Tcl_LongAsWide(0)) { + if (newLoc < 0) { SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart); goto invalid; } @@ -1576,7 +1576,7 @@ ReflectSeek( * routine. */ - return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode, + return ReflectSeekWide(clientData, offset, seekMode, errorCodePtr); } @@ -3079,7 +3079,7 @@ ForwardProc( Tcl_WideInt newLoc; if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) { - if (newLoc < Tcl_LongAsWide(0)) { + if (newLoc < 0) { ForwardSetStaticError(paramPtr, msg_seek_beforestart); paramPtr->seek.offset = -1; } else { diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 1a7b940..4841e39 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -1340,7 +1340,7 @@ ReflectSeekWide( if (seekProc == NULL) { Tcl_SetErrno(EINVAL); - return Tcl_LongAsWide(-1); + return -1; } /* @@ -1390,16 +1390,15 @@ ReflectSeekWide( parent->typePtr->wideSeekProc != NULL) { curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset, seekMode, errorCodePtr); - } else if (offset < Tcl_LongAsWide(LONG_MIN) || - offset > Tcl_LongAsWide(LONG_MAX)) { + } else if (offset < LONG_MIN || offset > LONG_MAX) { *errorCodePtr = EOVERFLOW; - curPos = Tcl_LongAsWide(-1); + curPos = -1; } else { - curPos = Tcl_LongAsWide(parent->typePtr->seekProc( - parent->instanceData, Tcl_WideAsLong(offset), seekMode, - errorCodePtr)); + curPos = parent->typePtr->seekProc( + parent->instanceData, offset, seekMode, + errorCodePtr); } - if (curPos == Tcl_LongAsWide(-1)) { + if (curPos == -1) { Tcl_SetErrno(*errorCodePtr); } @@ -1422,7 +1421,7 @@ ReflectSeek( * routine. */ - return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode, + return ReflectSeekWide(clientData, offset, seekMode, errorCodePtr); } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index bc8b287..11cc22d 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -275,8 +275,8 @@ Tcl_Stat( Tcl_WideInt tmp1, tmp2, tmp3 = 0; # define OUT_OF_RANGE(x) \ - (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \ - ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX)) + (((Tcl_WideInt)(x)) < LONG_MIN || \ + ((Tcl_WideInt)(x)) > LONG_MAX) # define OUT_OF_URANGE(x) \ (((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX)) diff --git a/generic/tclObj.c b/generic/tclObj.c index ce326fe..d1af60d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2807,7 +2807,7 @@ Tcl_GetLongFromObj( if (w >= -(Tcl_WideInt)(ULONG_MAX) && w <= (Tcl_WideInt)(ULONG_MAX)) { - *longPtr = Tcl_WideAsLong(w); + *longPtr = (long) w; return TCL_OK; } goto tooLarge; @@ -3536,7 +3536,7 @@ Tcl_SetBignumObj( while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } - if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) { + if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) { goto tooLargeForWide; } if (bignumValue->sign) { diff --git a/generic/tclPort.h b/generic/tclPort.h index 12a60db..33c0db6 100644 --- a/generic/tclPort.h +++ b/generic/tclPort.h @@ -24,20 +24,7 @@ #endif #include "tcl.h" -#if !defined(LLONG_MIN) -# ifdef TCL_WIDE_INT_IS_LONG -# define LLONG_MIN LONG_MIN -# else -# ifdef LLONG_BIT -# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1))) -# else -/* Assume we're on a system with a 64-bit 'long long' type */ -# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63)) -# endif -# endif -/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */ -# define LLONG_MAX (~LLONG_MIN) -#endif - +#define WIDE_MAX ((Tcl_WideInt)((~(Tcl_WideUInt)0) >> 1)) +#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1)) #endif /* _TCLPORT */ diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index f238268..fa55bb0 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2107,7 +2107,7 @@ Tcl_AppendFormatToObj( if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) { goto error; } else { - l = Tcl_WideAsLong(w); + l = (long) w; } if (useShort) { s = (short) l; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 36550ea..cdf547c 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -445,20 +445,14 @@ seekOld( int offset, /* Offset to seek to. */ int mode) /* Relative to which location to seek? */ { - Tcl_WideInt wOffset, wResult; - - wOffset = Tcl_LongAsWide((long) offset); - wResult = Tcl_Seek(chan, wOffset, mode); - return (int) Tcl_WideAsLong(wResult); + return Tcl_Seek(chan, offset, mode); } static int tellOld( Tcl_Channel chan) /* The channel to return pos for. */ { - Tcl_WideInt wResult = Tcl_Tell(chan); - - return (int) Tcl_WideAsLong(wResult); + return Tcl_Tell(chan); } #endif /* !TCL_NO_DEPRECATED */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 48b4761..18bfc1b 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2832,7 +2832,7 @@ TestlinkCmd( static int intVar = 43; static int boolVar = 4; static double realVar = 1.23; - static Tcl_WideInt wideVar = Tcl_LongAsWide(79); + static Tcl_WideInt wideVar = 79; static char *stringVar = NULL; static char charVar = '@'; static unsigned char ucharVar = 130; @@ -2842,7 +2842,7 @@ TestlinkCmd( static long longVar = 123456789L; static unsigned long ulongVar = 3456789012UL; static float floatVar = 4.5; - static Tcl_WideUInt uwideVar = (Tcl_WideUInt) Tcl_LongAsWide(123); + static Tcl_WideUInt uwideVar = 123; static int created = 0; char buffer[2*TCL_DOUBLE_SPACE]; int writable, flag; diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index ced684a..435579a 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -383,7 +383,7 @@ FileSeekProc( */ oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR); - if (oldLoc == Tcl_LongAsWide(-1)) { + if (oldLoc == -1) { /* * Bad things are happening. Error out... */ @@ -398,14 +398,14 @@ FileSeekProc( * Check for expressability in our return type, and roll-back otherwise. */ - if (newLoc > Tcl_LongAsWide(INT_MAX)) { + if (newLoc > INT_MAX) { *errorCodePtr = EOVERFLOW; TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET); return -1; } else { - *errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0; + *errorCodePtr = (newLoc == -1) ? errno : 0; } - return (int) Tcl_WideAsLong(newLoc); + return (int) newLoc; } /* diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 8ffb31f..8c47be6 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -554,8 +554,8 @@ FileWideSeekProc( moveMethod = FILE_END; } - newPosHigh = Tcl_WideAsLong(offset >> 32); - newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset), + newPosHigh = (LONG)(offset >> 32); + newPos = SetFilePointer(infoPtr->handle, (LONG)offset, &newPosHigh, moveMethod); if (newPos == (LONG) INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); @@ -567,7 +567,7 @@ FileWideSeekProc( } } return (((Tcl_WideInt)((unsigned)newPos)) - | (Tcl_LongAsWide(newPosHigh) << 32)); + | ((Tcl_WideInt)newPosHigh << 32)); } /* @@ -613,8 +613,8 @@ FileTruncateProc( * Move to where we want to truncate */ - newPosHigh = Tcl_WideAsLong(length >> 32); - newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length), + newPosHigh = (LONG)(length >> 32); + newPos = SetFilePointer(infoPtr->handle, (LONG)length, &newPosHigh, FILE_BEGIN); if (newPos == (LONG) INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); -- cgit v0.12 From bd42171094d5ada2e2e46978f2e842a66b6fa44e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Sep 2018 20:37:44 +0000 Subject: missing type-cast --- generic/tclStubInit.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index cdf547c..134b68f 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -249,7 +249,7 @@ Tcl_WinUtfToTChar( } Tcl_DStringSetLength(dsPtr, 2*size); wp[size] = 0; - return wp; + return (char *) wp; } char * -- cgit v0.12