merge 8.7

8 files changed, 95 insertions, 40 deletions

diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 80898fc..ddfe3bf 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -363,14 +363,7 @@ TclFileDeleteCmd(
 	 */
 
 	if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
-	    /*
-	     * Trying to delete a file that does not exist is not considered
-	     * an error, just a no-op
-	     */
-
-	    if (errno != ENOENT) {
-		result = TCL_ERROR;
-	    }
+	    result = TCL_ERROR;
 	} else if (S_ISDIR(statBuf.st_mode)) {
 	    /*
 	     * We own a reference count on errorBuffer, if it was set as a
@@ -406,13 +399,20 @@ TclFileDeleteCmd(
 	}
 
 	if (result != TCL_OK) {
-	    result = TCL_ERROR;
 
 	    /*
+	     * Avoid possible race condition (file/directory deleted after call
+	     * of lstat), so bypass ENOENT because not an error, just a no-op
+	     */
+	    if (errno == ENOENT) {
+		result = TCL_OK;
+		continue;
+	    }
+	    /*
 	     * It is important that we break on error, otherwise we might end
 	     * up owning reference counts on numerous errorBuffers.
 	     */
-
+	    result = TCL_ERROR;
 	    break;
 	}
     }
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 319bfa0..1d73a7a 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -1034,7 +1034,10 @@ Tcl_UtfToTitle(
 	    lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
 	}
 #endif
-	lowChar = Tcl_UniCharToLower(lowChar);
+	/* Special exception for Gregorian characters, which don't have titlecase */
+	if ((lowChar < 0x1C90) || (lowChar >= 0x1CC0)) {
+	    lowChar = Tcl_UniCharToLower(lowChar);
+	}
 
 	if (bytes < TclUtfCount(lowChar)) {
 	    memcpy(dst, src, (size_t) bytes);
@@ -1355,8 +1358,9 @@ Tcl_UniCharToLower(
 {
     if (!UNICODE_OUT_OF_RANGE(ch)) {
 	int info = GetUniCharInfo(ch);
+	int mode = GetCaseType(info);
 
-	if (GetCaseType(info) & 0x02) {
+	if ((mode & 0x02) && (mode != 0x7)) {
 	    ch += GetDelta(info);
 	}
     }
@@ -1392,7 +1396,9 @@ Tcl_UniCharToTitle(
 	     * Subtract or add one depending on the original case.
 	     */
 
-	    ch += ((mode & 0x4) ? -1 : 1);
+	    if (mode != 0x7) {
+		ch += ((mode & 0x4) ? -1 : 1);
+	    }
 	} else if (mode == 0x4) {
 	    ch -= GetDelta(info);
 	}
diff --git a/tests/fileName.test b/tests/fileName.test
index ce89623..7f983a7 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -778,6 +778,8 @@ test filename-11.16 {Tcl_GlobCmd} {
 } {globTest}
 set globname "globTest"
 set horribleglobname "glob\[\{Test"
+set tildeglobname "./~test.txt"
+
 test filename-11.17 {Tcl_GlobCmd} {unix} {
     lsort [glob -directory $globname *]
 } [lsort [list [file join $globname a1] [file join $globname a2]\
@@ -917,11 +919,12 @@ test filename-11.21.1 {Tcl_GlobCmd} -body {
 } -result {{[tcl].testremains}}
 # Get rid of file/dir if it exists, since it will have been left behind by a
 # previous failed run.
-if {[file exists $horribleglobname]} {
-    file delete -force $horribleglobname
-}
+file delete -force $horribleglobname
 file rename globTest $horribleglobname
 set globname $horribleglobname
+file delete -force $tildeglobname
+close [open $tildeglobname w]
+
 test filename-11.22 {Tcl_GlobCmd} {unix} {
     lsort [glob -dir $globname *]
 } [lsort [list [file join $globname a1] [file join $globname a2]\
@@ -1040,7 +1043,9 @@ test filename-11.41 {Tcl_GlobCmd} -body {
 test filename-11.42 {Tcl_GlobCmd} -body {
     set res [list]
     foreach f [glob -dir [pwd] *] {
-	lappend res [file tail $f]
+	set f [file tail $f]
+	regsub {^./} $f {} f; # until glob bug [2511011fff] don't fixed (tilde expansion prevention).
+	lappend res $f
     }
     list $res [glob *]
 } -match compareWords -result equal
@@ -1080,8 +1085,9 @@ test filename-11.49 {Tcl_GlobCmd} -returnCodes error -body {
 } -result {bad argument to "-types": abcde}
 
 file rename $horribleglobname globTest
+file delete -force $tildeglobname
 set globname globTest
-unset horribleglobname
+unset horribleglobname tildeglobname
 
 test filename-12.1 {simple globbing} {unixOrPc} {
     glob {}
diff --git a/tests/tcltest.test b/tests/tcltest.test
index cd3c621..286f017 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -551,6 +551,7 @@ switch -- $::tcl_platform(platform) {
 	file attributes $notWriteableDir -permissions 00555
     }
     default {
+	# note in FAT/NTFS we won't be able to protect directory with read-only attribute...
 	catch {file attributes $notWriteableDir -readonly 1}
 	catch {testchmod 0 $notWriteableDir}
     }
@@ -567,9 +568,10 @@ test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
 # This constraint doesn't go at the top of the file so that it doesn't
 # interfere with tcltest-5.5
 testConstraint notFAT [expr {
-    ![string match "FAT*" [lindex [file system $notWriteableDir] 1]]
+       ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]]
+    || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]]
 }]
-# FAT permissions are fairly hopeless; ignore this test if that FS is used
+# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
 test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
     -constraints {unixOrPc notRoot notFAT}
     -body {
diff --git a/tests/utf.test b/tests/utf.test
index af471e1..39818cc 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -250,6 +250,9 @@ test utf-11.3 {Tcl_UtfToUpper} {
 test utf-11.4 {Tcl_UtfToUpper} {
     string toupper \u01e3ab
 } \u01e2AB
+test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
+    string toupper \u10d0\u1c90
+} \u1c90\u1c90
 
 test utf-12.1 {Tcl_UtfToLower} {
     string tolower {}
@@ -263,6 +266,9 @@ test utf-12.3 {Tcl_UtfToLower} {
 test utf-12.4 {Tcl_UtfToLower} {
     string tolower \u01e2AB
 } \u01e3ab
+test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
+    string tolower \u10d0\u1c90
+} \u10d0\u10d0
 
 test utf-13.1 {Tcl_UtfToTitle} {
     string totitle {}
@@ -276,6 +282,12 @@ test utf-13.3 {Tcl_UtfToTitle} {
 test utf-13.4 {Tcl_UtfToTitle} {
     string totitle \u01f3ab
 } \u01f2ab
+test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
+    string totitle \u10d0\u1c90
+} \u10d0\u1c90
+test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
+    string totitle \u1c90\u10d0
+} \u1c90\u10d0
 
 test utf-14.1 {Tcl_UtfNcasecmp} {
     string compare -nocase a b
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 294745c..e9886dc 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -1056,6 +1056,15 @@ test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
 } -cleanup {
     file delete -force -- c:/td1
 } -result {c:/td1}
+test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup {
+    catch {file delete -force -- $::env(TEMP)/td1}
+} -constraints {win} -body {
+    createfile $::env(TEMP)/td1 {}
+    string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \
+	    [string tolower [file normalize $::env(TEMP)]/td1]]
+} -cleanup {
+    file delete -force -- $::env(TEMP)/td1
+} -result 1
 test winFCmd-12.7 {ConvertFileNameFormat} -body {
     string tolower [file attributes //bisque/tcl/ws -longname]
 } -constraints {nonPortable win} -result {//bisque/tcl/ws}
diff --git a/tools/uniClass.tcl b/tools/uniClass.tcl
index 8047894..86ec931 100644
--- a/tools/uniClass.tcl
+++ b/tools/uniClass.tcl
@@ -66,7 +66,7 @@ proc genTable {type} {
     for {set i 0} {$i <= 0x10ffff} {incr i} {
     if {$i == 0xd800} {
 	# Skip surrogates
-	set i 0xdc00
+	set i 0xe000
     }
 	if {[string is $type [format %c $i]]} {
 	    if {$i == ($last + 1)} {
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 700e3c8..7693f06 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1561,11 +1561,12 @@ NativeAccess(
 	return 0;
     }
 
-    if ((mode & W_OK)
-	&& (attr & FILE_ATTRIBUTE_READONLY)
-	&& !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
+    /* 
+     * If it's not a directory (assume file), do several fast checks:
+     */
+    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
 	/*
-	 * The attributes say the file is not writable.	 If the file is a
+	 * If the attributes say this is not writable at all.  The file is a
 	 * regular file (i.e., not a directory), then the file is not
 	 * writable, full stop.	 For directories, the read-only bit is
 	 * (mostly) ignored by Windows, so we can't ascertain anything about
@@ -1573,21 +1574,38 @@ NativeAccess(
 	 * advanced 'getFileSecurityProc', then more robust ACL checks
 	 * will be done below.
 	 */
+	if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
+	    Tcl_SetErrno(EACCES);
+	    return -1;
+	}
 
-	Tcl_SetErrno(EACCES);
-	return -1;
-    }
-
-    if (mode & X_OK) {
-	if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) {
-	    /*
-	     * It's not a directory and doesn't have the correct extension.
-	     * Therefore it can't be executable
-	     */
-
+	/* If doesn't have the correct extension, it can't be executable */
+	if ((mode & X_OK) && !NativeIsExec(nativePath)) {
 	    Tcl_SetErrno(EACCES);
 	    return -1;
 	}
+	/* Special case for read/write/executable check on file */
+	if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) {
+	    DWORD mask = 0;
+	    HANDLE hFile;
+	    if (mode & R_OK) { mask |= GENERIC_READ;  }
+	    if (mode & W_OK) { mask |= GENERIC_WRITE; }
+	    if (mode & X_OK) { mask |= GENERIC_EXECUTE; }
+
+	    hFile = CreateFile(nativePath, mask,
+		FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
+		OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
+	    if (hFile != INVALID_HANDLE_VALUE) {
+		CloseHandle(hFile);
+		return 0;
+	    }
+	    /* fast exit if access was denied */
+	    if (GetLastError() == ERROR_ACCESS_DENIED) {
+		Tcl_SetErrno(EACCES);
+		return -1;
+	    }
+	}
+	/* We cannnot verify the access fast, check it below using security info. */
     }
 
     /*
@@ -1792,10 +1810,12 @@ NativeIsExec(
 	return 0;
     }
 
-    if ((_tcsicmp(path+len-3, TEXT("exe")) == 0)
-	    || (_tcsicmp(path+len-3, TEXT("com")) == 0)
-	    || (_tcsicmp(path+len-3, TEXT("cmd")) == 0)
-	    || (_tcsicmp(path+len-3, TEXT("bat")) == 0)) {
+    path += len-3;
+    if ((_tcsicmp(path, TEXT("exe")) == 0)
+	    || (_tcsicmp(path, TEXT("com")) == 0)
+	    || (_tcsicmp(path, TEXT("cmd")) == 0)
+	    || (_tcsicmp(path, TEXT("cmd")) == 0)
+	    || (_tcsicmp(path, TEXT("bat")) == 0)) {
 	return 1;
     }
     return 0;