From 1676722753b69ec304ed95a1d75b24501b5445a4 Mon Sep 17 00:00:00 2001
From: patthoyts <patthoyts@users.sourceforge.net>
Date: Sun, 1 Oct 2006 13:03:56 +0000
Subject: bug #1420432 - file mtime fails for directories on windows

---
 ChangeLog        |  3 +++
 tests/cmdAH.test | 18 ++++++++++++++++--
 win/tclWinFile.c | 18 ++++++++++++++----
 3 files changed, 33 insertions(+), 6 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 2c99433..0225125 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2006-10-01  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
+	* win/tclWinFile.c (TclpUtime): bug #1420432 - file mtime fails
+	* tests/cmdAH.test:	        for directories on windows
+
 	* tests/winFile.test: Handle Msys environment a little differently
 	in getuser function. Fix for bug 1567956.
 
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 300e217..3f12dd2 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.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: cmdAH.test,v 1.53 2006/03/21 11:12:28 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.54 2006/10/01 13:03:56 patthoyts Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -1233,7 +1233,6 @@ rename waitForEvenSecondForFAT {}
 
 test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} {
     set name [file join [temporaryDirectory] clockchange]
-
     file delete -force $name
     close [open $name w]
     set time [clock scan "21:00:00 October 30 2004 GMT"]
@@ -1243,6 +1242,21 @@ test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} {
     expr {$newmtime == $time ? 1 : "$newmtime != $time"}
 } {1}
 
+# bug 1420432: setting mtime fails for directories on windows.
+test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} {
+    set dirname [file join [temporaryDirectory] tmp[pid]]
+    file delete -force $dirname
+    file mkdir $dirname
+    set res [catch {
+        set old [file mtime $dirname]
+        file mtime $dirname 0
+        set new [file mtime $dirname]
+        list $new [expr {$old != $new}]
+    } err]
+    file delete -force $dirname
+    list $res $err
+} {0 {0 1}}
+
 # owned
 
 test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 03ccf9d..ce4dae4 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.86 2006/08/29 00:36:57 coldstore Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.87 2006/10/01 13:03:56 patthoyts Exp $
  */
 
 /* #define _WIN32_WINNT	0x0500 */
@@ -3355,10 +3355,21 @@ TclpUtime(
 {
     int res = 0;
     HANDLE fileHandle;
+    CONST TCHAR *native;
+    DWORD attr = 0;
+    DWORD flags = FILE_ATTRIBUTE_NORMAL;
     FILETIME lastAccessTime, lastModTime;
 
     FromCTime(tval->actime, &lastAccessTime);
     FromCTime(tval->modtime, &lastModTime);
+    
+    native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr);
+
+    attr = (*tclWinProcs->getFileAttributesProc)(native);
+
+    if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
+	flags = FILE_FLAG_BACKUP_SEMANTICS;
+    }
 
     /*
      * We use the native APIs (not 'utime') because there are some daylight
@@ -3366,9 +3377,8 @@ TclpUtime(
      */
 
     fileHandle = (tclWinProcs->createFileProc) (
-	    (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr),
-	    FILE_WRITE_ATTRIBUTES, 0, NULL, OPEN_EXISTING,
-	    FILE_ATTRIBUTE_NORMAL, NULL);
+	    native, FILE_WRITE_ATTRIBUTES, 0, NULL,
+	    OPEN_EXISTING, flags, NULL);
 
     if (fileHandle == INVALID_HANDLE_VALUE ||
 	    !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
-- 
cgit v0.12