[Bug 2893771] Teach [file stat] to handle locked files.

This stops [file exists] from returning false for files that exist but are locked by
resorting to FindFirstFile when GetFileAttributes fails.

3 files changed, 55 insertions, 23 deletions

diff --git a/ChangeLog b/ChangeLog
index c24421a..d5b9889 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-11-24  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* tests/fCmd.test:  [Bug 2893771] Teach [file stat] to handle locked
+	* win/tclWinFile.c: files so that [file exists] no longer lies.
+
 2009-11-23  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* library/tclIndex  (regenerated) to reflect various changes
diff --git a/tests/fCmd.test b/tests/fCmd.test
index c677a45..1436a28 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fCmd.test,v 1.69 2009/11/23 22:14:27 kennykb Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.70 2009/11/24 00:08:27 patthoyts Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -2552,17 +2552,22 @@ test fCmd-30.1 {file writable on 'My Documents'} -setup {
 } -constraints {2000orNewer reg} -body {
     file writable $mydocsname
 } -result 1
-test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {2000orNewer knownBug} -body {
-    # Apparently the OS has this file open with exclusive permissions Windows
-    # doesn't provide any way to determine that fact without actually trying
-    # to open the file (open NTUSER.dat r), which fails. Hence this isn't
-    # really a knownBug in Tcl, but an OS limitation. But, perhaps in the
-    # future that limitation will be lifted.
-    if {[file exists "~/NTUSER.DAT"]} {
-	return [file readable "~/NTUSER.DAT"]
+test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {2000orNewer} -body {
+    expr {[info exists env(USERPROFILE)]
+          && [file exists $env(USERPROFILE)/NTUSER.DAT]
+          && [file readable $env(USERPROFILE)/NTUSER.DAT]}
+
+} -result {1}
+test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {2000orNewer} -body {
+    set r {}
+    if {[info exists env(SystemDrive)]} {
+        set path $env(SystemDrive)/pagefile.sys
+        lappend r exists [file exists $path]
+        lappend r readable [file readable $path]
+        lappend r stat [catch {file stat $path a} e] $e
     }
-    return 0
-} -result {0}
+    return $r
+} -result {exists 1 readable 0 stat 0 {}}
 
 # cleanup
 cleanup
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 46c8489..25e1eac 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFile.c,v 1.98 2009/03/18 17:08:11 dgp Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.99 2009/11/24 00:08:27 patthoyts Exp $
  */
 
 /* #define _WIN32_WINNT	0x0500 */
@@ -247,7 +247,7 @@ WinLink(
      */
 
     attr = tclWinProcs->getFileAttributesProc(linkSourcePath);
-    if (attr != 0xffffffff) {
+    if (attr != INVALID_FILE_ATTRIBUTES) {
 	Tcl_SetErrno(EEXIST);
 	return -1;
     }
@@ -271,7 +271,7 @@ WinLink(
      */
 
     attr = tclWinProcs->getFileAttributesProc(linkTargetPath);
-    if (attr == 0xffffffff) {
+    if (attr == INVALID_FILE_ATTRIBUTES) {
 	/*
 	 * The target doesn't exist.
 	 */
@@ -368,7 +368,7 @@ WinReadLink(
      */
 
     attr = tclWinProcs->getFileAttributesProc(linkSourcePath);
-    if (attr == 0xffffffff) {
+    if (attr == INVALID_FILE_ATTRIBUTES) {
 	/*
 	 * The source doesn't exist.
 	 */
@@ -912,7 +912,7 @@ TclpMatchInDirectory(
 
 	    if (tclWinProcs->getFileAttributesExProc == NULL) {
 		attr = tclWinProcs->getFileAttributesProc(native);
-		if (attr == 0xffffffff) {
+		if (attr == INVALID_FILE_ATTRIBUTES) {
 		    return TCL_OK;
 		}
 	    } else {
@@ -964,7 +964,8 @@ TclpMatchInDirectory(
 	}
 	attr = tclWinProcs->getFileAttributesProc(native);
 
-	if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+	if ((attr == INVALID_FILE_ATTRIBUTES) 
+	    || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
 	    return TCL_OK;
 	}
 
@@ -1547,13 +1548,21 @@ NativeAccess(
 
     attr = tclWinProcs->getFileAttributesProc(nativePath);
 
-    if (attr == 0xffffffff) {
+    if (attr == INVALID_FILE_ATTRIBUTES) {
 	/*
-	 * File doesn't exist.
+	 * File might not exist.
 	 */
 
-	TclWinConvertError(GetLastError());
-	return -1;
+	WIN32_FIND_DATAT ffd;
+	HANDLE hFind;
+	hFind = tclWinProcs->findFirstFileProc(nativePath, &ffd);
+	if (hFind != INVALID_HANDLE_VALUE) {
+	    attr = ffd.w.dwFileAttributes;
+	    FindClose(hFind);
+	} else {
+	    TclWinConvertError(GetLastError());
+	    return -1;
+	}
     }
 
     if ((mode & W_OK)
@@ -2093,8 +2102,21 @@ NativeStat(
 
 	if (tclWinProcs->getFileAttributesExProc(nativePath,
 		GetFileExInfoStandard, &data) != TRUE) {
-	    Tcl_SetErrno(ENOENT);
-	    return -1;
+
+	    /*
+	     * We might have just been denied access
+	     */
+	    
+	    WIN32_FIND_DATAT ffd;
+	    HANDLE hFind;
+	    hFind = tclWinProcs->findFirstFileProc(nativePath, &ffd);
+	    if (hFind != INVALID_HANDLE_VALUE) {
+		memcpy(&data, &ffd, sizeof(data));
+		FindClose(hFind);
+	    } else {
+		Tcl_SetErrno(ENOENT);
+		return -1;
+	    }
 	}
 
 	attr = data.dwFileAttributes;