summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCmdAH.c19
-rw-r--r--tests/cmdAH.test56
-rwxr-xr-xwin/tclWinFile.c43
-rw-r--r--win/tclWinPort.h14
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)
generated by cgit v0.12 at 2024-07-18 23:43:50 (GMT)