Bugfix [ae61a67192]. file {stat, type, size} etc. support for built-in special Windows files/devices like CON.

4 files changed, 120 insertions, 12 deletions

diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 54e0227..a53f1f7 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1157,6 +1157,16 @@ FileAttrAccessTimeCmd(
     if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
 	return TCL_ERROR;
     }
+#if defined(_WIN32)
+    /* We use a value of 0 to indicate the access time not available */
+    if (buf.st_atime == 0) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                             "could not get access time for file \"%s\"",
+                             TclGetString(objv[1])));
+        return TCL_ERROR;
+    }
+#endif
+
     if (objc == 3) {
 	/*
 	 * Need separate variable for reading longs from an object on 64-bit
@@ -1229,6 +1239,15 @@ FileAttrModifyTimeCmd(
     if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
 	return TCL_ERROR;
     }
+#if defined(_WIN32)
+    /* We use a value of 0 to indicate the modification time not available */
+    if (buf.st_mtime == 0) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                             "could not get modification time for file \"%s\"",
+                             TclGetString(objv[1])));
+        return TCL_ERROR;
+    }
+#endif
     if (objc == 3) {
 	/*
 	 * Need separate variable for reading longs from an object on 64-bit
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index f2f7f8c..6240500 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -1026,6 +1026,16 @@ test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup {
     set modatime [file atime $file $newatime]
     expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
 } -result 1
+test cmdAH-20.7 {
+    Tcl_FileObjCmd: atime (built-in Windows names)
+} -constraints {win} -body {
+    file atime con
+} -result "could not get access time for file \"con\"" -returnCodes error
+test cmdAH-20.7.1 {
+    Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+    file atime [file join [temporaryDirectory] CON.txt]
+} -result "could not get access time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
 
 if {[testConstraint unix] && [file exists /tmp]} {
     removeFile touch.me /tmp
@@ -1257,6 +1267,16 @@ test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
 } -cleanup {
     file delete -force $dirname
 } -result {0 1}
+test cmdAH-24.14 {
+    Tcl_FileObjCmd: mtime (built-in Windows names)
+} -constraints {win} -body {
+    file mtime con
+} -result "could not get modification time for file \"con\"" -returnCodes error
+test cmdAH-24.14.1 {
+    Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+    file mtime [file join [temporaryDirectory] CON.txt]
+} -result "could not get modification time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
 
 # owned
 test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
@@ -1306,6 +1326,16 @@ test cmdAH-27.2 {Tcl_FileObjCmd: size} {
 test cmdAH-27.3 {Tcl_FileObjCmd: size} {
     list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
 } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-27.4 {
+    Tcl_FileObjCmd: size (built-in Windows names)
+} -constraints {win} -body {
+    file size con
+} -result 0
+test cmdAH-27.4.1 {
+    Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+    file size [file join [temporaryDirectory] con.txt]
+} -result 0
 
 catch {testsetplatform $platform}
 removeFile $gorpfile
@@ -1397,12 +1427,24 @@ test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
 } -cleanup {
     removeFile $filename
 } -result 1
+test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -setup {
+    unset -nocomplain stat
+} -body {
+    file stat con stat
+    lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
+} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
+test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -setup {
+    unset -nocomplain stat
+} -body {
+    file stat [file join [temporaryDirectory] CON.txt] stat
+    lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
+} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
 unset -nocomplain stat
 
 # type
 test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
-    file size a b
-} -result {wrong # args: should be "file size name"}
+    file type a b
+} -result {wrong # args: should be "file type name"}
 test cmdAH-29.2 {Tcl_FileObjCmd: type} {
     file type $dirfile
 } directory
@@ -1437,6 +1479,16 @@ test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
 test cmdAH-29.5 {Tcl_FileObjCmd: type} {
     list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
 } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-29.6 {
+    Tcl_FileObjCmd: type (built-in Windows names)
+} -constraints {win} -body {
+    file type con
+} -result "characterSpecial"
+test cmdAH-29.6.1 {
+    Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
+} -constraints {win} -body {
+    file type [file join [temporaryDirectory] CON.txt]
+} -result "characterSpecial"
 
 # Error conditions
 test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 4b0b884..7f6dff9 100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1953,6 +1953,7 @@ NativeStat(
     unsigned short mode;
     unsigned int inode = 0;
     HANDLE fileHandle;
+    DWORD fileType = FILE_TYPE_UNKNOWN;
 
     /*
      * If we can use 'createFile' on this, then we can use the resulting
@@ -1960,6 +1961,14 @@ NativeStat(
      * other attributes reading APIs. If not, then we try to fall back on the
      * 'getFileAttributesExProc', and if that isn't available, then on even
      * simpler routines.
+     *
+     * Special consideration must be given to Windows hardcoded names
+     * like CON, NULL, COM1, LPT1 etc. For these, we still need to
+     * do the CreateFile as some may not exist (e.g. there is no CON
+     * in wish by default). However the subsequent GetFileInformationByHandle
+     * will fail. We do a WinIsReserved to see if it is one of the special
+     * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
+     * structure.
      */
 
     fileHandle = CreateFile(nativePath, GENERIC_READ,
@@ -1970,19 +1979,26 @@ NativeStat(
 	BY_HANDLE_FILE_INFORMATION data;
 
 	if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {
-	    CloseHandle(fileHandle);
-	    Tcl_SetErrno(ENOENT);
-	    return -1;
-	}
-	CloseHandle(fileHandle);
-
+            fileType = GetFileType(fileHandle);
+            CloseHandle(fileHandle);
+            if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) {
+                Tcl_SetErrno(ENOENT);
+                return -1;
+            }
+            /* Mock up the expected structure */
+            memset(&data, 0, sizeof(data));
+            statPtr->st_atime = 0;
+            statPtr->st_mtime = 0;
+            statPtr->st_ctime = 0;
+        } else {
+            CloseHandle(fileHandle);
+            statPtr->st_atime = ToCTime(data.ftLastAccessTime);
+            statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
+            statPtr->st_ctime = ToCTime(data.ftCreationTime);
+        }
 	attr = data.dwFileAttributes;
-
 	statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
 		(((Tcl_WideInt) data.nFileSizeHigh) << 32);
-	statPtr->st_atime = ToCTime(data.ftLastAccessTime);
-	statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
-	statPtr->st_ctime = ToCTime(data.ftCreationTime);
 
 	/*
 	 * On Unix, for directories, nlink apparently depends on the number of
@@ -2038,6 +2054,13 @@ NativeStat(
 
     dev = NativeDev(nativePath);
     mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
+    if (fileType == FILE_TYPE_CHAR) {
+        mode &= ~S_IFMT;
+        mode |= S_IFCHR;
+    } else if (fileType == FILE_TYPE_DISK) {
+        mode &= ~S_IFMT;
+        mode |= S_IFBLK;
+    }
 
     statPtr->st_dev	= (dev_t) dev;
     statPtr->st_ino	= inode;
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index ca6b2bf..b486466 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -360,6 +360,20 @@ typedef DWORD_PTR * PDWORD_PTR;
 #   define S_IFLNK        0120000  /* Symbolic Link */
 #endif
 
+/* 
+ * Windows compilers do not define S_IFBLK. However, Tcl uses it in
+ * GetTypeFromMode to identify blockSpecial devices based on the
+ * value in the statsbuf st_mode field. We have no other way to pass this
+ * from NativeStat on Windows so are forced to define it here.
+ * The definition here is essentially what is seen on Linux and MingW.
+ * XXX - the root problem is Tcl using Unix definitions instead of
+ * abstracting the structure into a platform independent one. Sigh - perhaps
+ * Tcl 9
+ */
+#ifndef S_IFBLK
+#   define S_IFBLK (S_IFDIR | S_IFCHR)
+#endif
+
 #ifndef S_ISREG
 #   ifdef S_IFREG
 #       define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)