[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.

1 files changed, 16 insertions, 11 deletions

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