From 7e0a9605b9a1e3bc52ff27cdbc7311608f4cce18 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 8 Apr 2014 14:52:04 +0000 Subject: Provide full Tcl patchlevel to tcl.pc and move private libs to "Libs.private". --- unix/tcl.pc.in | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in index 6b6fe44..b750300 100644 --- a/unix/tcl.pc.in +++ b/unix/tcl.pc.in @@ -8,8 +8,7 @@ includedir=@includedir@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. URL: http://www.tcl.tk/ -Version: @TCL_VERSION@ -Requires: -Conflicts: -Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_LIBS@ +Version: @TCL_VERSION@@TCL_PATCH_LEVEL@ +Libs: -L${libdir} @TCL_LIB_FLAG@ +Libs.private: @TCL_LIBS@ Cflags: -I${includedir} -- cgit v0.12 From da36dfe69e58aec61afac3c396af8cf6107b0ff1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Apr 2014 07:57:18 +0000 Subject: Fix bug [e663138a06]: Test failures in "string is" --- generic/tclExecute.c | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 41730d3..6394a60 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5990,6 +5990,15 @@ TEBCresume( if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; } +#ifndef TCL_WIDE_INT_IS_LONG + else if (type1 == TCL_NUMBER_WIDE) { + /** See bug [e663138a06] */ + Tcl_WideInt value = (OBJ_AT_TOS)->internalRep.wideValue; + if ((-value <= ULONG_MAX) && (value <= ULONG_MAX)) { + type1 = TCL_NUMBER_LONG; + } + } +#endif TclNewIntObj(objResultPtr, type1); TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1)); NEXT_INST_F(1, 1, 1); -- cgit v0.12 From c5510a29171fa3a62f7a51af11bea2772bf10e3e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Apr 2014 13:32:14 +0000 Subject: [792641f95b]: Normalized win32 paths should never contain backslash. --- win/tclWinFCmd.c | 5 +++++ win/tclWinFile.c | 15 ++++++--------- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 8999831..441337e 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1156,7 +1156,12 @@ DoRemoveJustDirectory( end: if (errorPtr != NULL) { + char *p; Tcl_WinTCharToUtf(nativePath, -1, errorPtr); + p = Tcl_DStringValue(errorPtr); + for (; *p; ++p) { + if (*p == '\\') *p = '/'; + } } return TCL_ERROR; diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 676c443..ed0c40f 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -3197,17 +3197,14 @@ TclNativeCreateNativeRep( } str = Tcl_GetStringFromObj(validPathPtr, &len); - if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') { - char *p; - - for (p = str; p && *p; ++p) { - if (*p == '/') { - *p = '\\'; - } - } - } Tcl_WinUtfToTChar(str, len, &ds); if (tclWinProcs->useWide) { + WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds); + for (; *wp; ++wp) { + if (*wp=='/') { + *wp = '\\'; + } + } len = Tcl_DStringLength(&ds) + sizeof(WCHAR); } else { len = Tcl_DStringLength(&ds) + sizeof(char); -- cgit v0.12 From 09e3a3c56b5d44c637c6ed0593257e51461e8861 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 11 Apr 2014 08:23:44 +0000 Subject: Fix [3118489] for Windows only: NUL in filenames. This allows various characters to be used in win32 filenames which are normally invalid, as described here: [http://cygwin.com/cygwin-ug-net/using-specialnames.html#pathnames-specialchars]. The Cygwin shell can handle those same filenames as well. In other shells (cmd.exe/mSys) or on the Windows desktop the filenames will look strange, but that's all. --- tests/cmdAH.test | 3 +++ win/tclWinFile.c | 8 +++++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 39e9ece..80706b6 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -141,6 +141,9 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup { } -cleanup { cd $dir } -result {/} +test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -constraints win -returnCodes error -body { + cd .\0 +} -result "couldn't change working directory to \".\0\": no such file or directory" test cmdAH-2.7 {Tcl_ConcatObjCmd} { concat } {} diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 80d0915..c9b95a0 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -2897,7 +2897,7 @@ TclNativeCreateNativeRep( char *nativePathPtr, *str; Tcl_DString ds; Tcl_Obj *validPathPtr; - int len; + int len, i = 2; WCHAR *wp; if (TclFSCwdIsNative()) { @@ -2927,8 +2927,10 @@ TclNativeCreateNativeRep( Tcl_WinUtfToTChar(str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(WCHAR); wp = (WCHAR *) Tcl_DStringValue(&ds); - for (; *wp; ++wp) { - if (*wp=='/') { + for (i=sizeof(WCHAR); i|", *wp) ){ + *wp |= 0xF000; + }else if (*wp=='/') { *wp = '\\'; } } -- cgit v0.12 From 7fb053c9643440e5075f5e513853c9efff0ae44d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 11 Apr 2014 09:55:15 +0000 Subject: Fix [3118489]: NUL in filenames, now fixed for both Windows and UNIX. For consistancy, any NUL character in a filename prevents the native filesystem to generate a native file representation for it. Other filesystems than the native one may still accept it, but it's not recommended. --- tests/cmdAH.test | 2 +- unix/tclUnixFile.c | 6 ++++++ win/tclWinFile.c | 9 +++++++++ 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 80706b6..04a86fa 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -141,7 +141,7 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup { } -cleanup { cd $dir } -result {/} -test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -constraints win -returnCodes error -body { +test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body { cd .\0 } -result "couldn't change working directory to \".\0\": no such file or directory" test cmdAH-2.7 {Tcl_ConcatObjCmd} { diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 5bfe5d9..2cb0027 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -1105,6 +1105,12 @@ TclNativeCreateNativeRep( str = Tcl_GetStringFromObj(validPathPtr, &len); Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); + if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { + /* See bug [3118489]: NUL in filenames */ + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } Tcl_DecrRefCount(validPathPtr); nativePathPtr = ckalloc(len); memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index c9b95a0..fc0ac9e 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1816,6 +1816,9 @@ TclpObjChdir( nativePath = Tcl_FSGetNativePath(pathPtr); + if (!nativePath) { + return -1; + } result = SetCurrentDirectory(nativePath); if (result == 0) { @@ -2929,6 +2932,12 @@ TclNativeCreateNativeRep( wp = (WCHAR *) Tcl_DStringValue(&ds); for (i=sizeof(WCHAR); i|", *wp) ){ + if (!*wp){ + /* See bug [3118489]: NUL in filenames */ + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } *wp |= 0xF000; }else if (*wp=='/') { *wp = '\\'; -- cgit v0.12 From 7b02be1867d1e46c5a4b5bc9f8925a4a6784c3fd Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 14 Apr 2014 18:45:04 +0000 Subject: [e663138a06] Fix the new INST_NUM_TYPE instruction so that the boundary cases of [string is] on integral values are computed right. Code is now correct, though still suffers from a large amount of ugly. --- generic/tclExecute.c | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6394a60..2c136d7 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5989,16 +5989,32 @@ TEBCresume( case INST_NUM_TYPE: if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; - } + } else if (type1 == TCL_NUMBER_LONG) { + /* value is between LONG_MIN and LONG_MAX */ + /* [string is integer] is -UINT_MAX to UINT_MAX range */ + int i; + + if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) { + type1 = TCL_NUMBER_WIDE; + } #ifndef TCL_WIDE_INT_IS_LONG - else if (type1 == TCL_NUMBER_WIDE) { - /** See bug [e663138a06] */ - Tcl_WideInt value = (OBJ_AT_TOS)->internalRep.wideValue; - if ((-value <= ULONG_MAX) && (value <= ULONG_MAX)) { + } else if (type1 == TCL_NUMBER_WIDE) { + /* value is between WIDE_MIN and WIDE_MAX */ + /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ + int i; + if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { type1 = TCL_NUMBER_LONG; } - } #endif + } else if (type1 == TCL_NUMBER_BIG) { + /* value is an integer outside the WIDE_MIN to WIDE_MAX range */ + /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ + Tcl_WideInt w; + + if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { + type1 = TCL_NUMBER_WIDE; + } + } TclNewIntObj(objResultPtr, type1); TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1)); NEXT_INST_F(1, 1, 1); -- cgit v0.12 From 363b6911107557283c7fec07e041e14c7af7eee3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 15 Apr 2014 10:41:44 +0000 Subject: Test-cases which pick up the completion of bug-fix [e663138a06d98e48b5fbb42cc015cf1698f486cd|e663138a06]. Thanks, Don! --- tests/obj.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/obj.test b/tests/obj.test index 71a39b4..151abfb 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -605,7 +605,7 @@ test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} -test obj-33.3 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.3 {integer overflow on input} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {0 4294967296} @@ -621,7 +621,7 @@ test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} { set x -0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 -4294967295} -test obj-33.7 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.7 {integer overflow on input} { set x -0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {0 -4294967296} -- cgit v0.12