minor filesystem bug fixes

4 files changed, 117 insertions, 17 deletions

diff --git a/ChangeLog b/ChangeLog
index 4c0754c..01573d4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2003-09-16  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* doc/filename.n: documentation of Windows-specific feature as
+        discussed in [Bug 541989]
+	* generic/tclPathObj.c: fix for normalization of volume-relative
+        paths [Bug 767834]
+        * tests/winFCmd.test: new tests for both of the above. 
+
 2003-09-13  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
 	TIP#123 IMPLEMENTATION BASED ON WORK BY ARJEN MARKUS
diff --git a/doc/filename.n b/doc/filename.n
index c0e2a68..de77d8c 100644
--- a/doc/filename.n
+++ b/doc/filename.n
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: filename.n,v 1.7 2001/09/04 18:06:34 vincentdarley Exp $
+'\" RCS: @(#) $Id: filename.n,v 1.8 2003/09/16 14:56:08 vincentdarley Exp $
 '\" 
 .so man.macros
 .TH filename n 7.5 Tcl "Tcl Built-In Commands"
@@ -200,15 +200,22 @@ Not all file systems are case sensitive, so scripts should avoid code
 that depends on the case of characters in a file name.  In addition,
 the character sets allowed on different devices may differ, so scripts
 should choose file names that do not contain special characters like:
-\fB<>:"/\e|\fR.  The safest approach is to use names consisting of
-alphanumeric characters only.  Also Windows 3.1 only supports file
+\fB<>:?"/\e|\fR.  The safest approach is to use names consisting of
+alphanumeric characters only.  Care should be taken with filenames
+which contain spaces (common on Windows and MacOS systems) and
+filenames where the backslash is the directory separator (Windows
+native path names).  Also Windows 3.1 only supports file
 names with a root of no more than 8 characters and an extension of no
 more than 3 characters.
 .PP
 On Windows platforms there are file and path length restrictions. 
 Complete paths or filenames longer than about 260 characters will lead
 to errors in most file operations.
-
+.PP
+Another Windows peculiarity is that any number of trailing dots '.'  in
+filenames are totally ignored, so, for example, attempts to create a
+file or directory with a name "foo." will result in the creation of a
+file/directory with name "foo".
 .SH KEYWORDS
 current directory, absolute file name, relative file name,
 volume-relative file name, portability
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 87ec24b..e7718b1 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -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: tclPathObj.c,v 1.6 2003/08/23 12:16:49 vasiljevic Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.7 2003/09/16 14:56:08 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1177,6 +1177,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr)
 	 */
 	Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
 	char *path = Tcl_GetString(absolutePath);
+	int type;
 	
 	/* 
 	 * We have to be a little bit careful here to avoid infinite loops
@@ -1184,17 +1185,61 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr)
 	 * that call can actually result in a lot of other filesystem
 	 * action, which might loop back through here.
 	 */
-	if ((path[0] != '\0') && 
-	  (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) {
-	    useThisCwd = Tcl_FSGetCwd(interp);
+	if (path[0] != '\0') {
+	    type = Tcl_FSGetPathType(pathObjPtr);
+	    if (type == TCL_PATH_RELATIVE) {
+		useThisCwd = Tcl_FSGetCwd(interp);
 
-	    if (useThisCwd == NULL) {
-		return NULL;
-	    }
+		if (useThisCwd == NULL) return NULL;
 
-	    absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
-	    Tcl_IncrRefCount(absolutePath);
-	    /* We have a refCount on the cwd */
+		absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
+		Tcl_IncrRefCount(absolutePath);
+		/* We have a refCount on the cwd */
+	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
+		/* 
+		 * Only Windows has volume-relative paths.  These
+		 * paths are rather rare, but is is nice if Tcl can
+		 * handle them.  It is much better if we can
+		 * handle them here, rather than in the native fs code,
+		 * because we really need to have a real absolute path
+		 * just below.
+		 */
+		useThisCwd = Tcl_FSGetCwd(interp);
+		if (useThisCwd == NULL) return NULL;
+		
+		if (path[0] == '/') {
+		    /* 
+		     * Path of form /foo/bar which is a path in the
+		     * root directory of the current volume.
+		     */
+		    CONST char *drive = Tcl_GetString(useThisCwd);
+		    absolutePath = Tcl_NewStringObj(drive,2);
+		    Tcl_AppendToObj(absolutePath, path, -1);
+		    Tcl_IncrRefCount(absolutePath);
+		    /* We have a refCount on the cwd */
+		} else {
+		    /* 
+		     * Path of form C:foo/bar, but this only makes
+		     * sense if the cwd is also on drive C.
+		     */
+		    CONST char *drive = Tcl_GetString(useThisCwd);
+		    char drive_c = path[0];
+		    if (drive_c >= 'a') {
+			drive_c -= ('a' - 'A');
+		    }
+		    if (drive[0] == drive_c) {
+			absolutePath = Tcl_DuplicateObj(useThisCwd);
+			Tcl_IncrRefCount(absolutePath);
+			Tcl_AppendToObj(absolutePath, "/", 1);
+			Tcl_AppendToObj(absolutePath, path+2, -1);
+			/* We have a refCount on the cwd */
+		    } else {
+			/* We just can't handle it correctly here */
+			Tcl_DecrRefCount(useThisCwd);
+			useThisCwd = NULL;
+		    }
+		}
+	    }
 	}
 	/* Already has refCount incremented */
 	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, 
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 52c470c..2829fb6 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.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: winFCmd.test,v 1.21 2003/07/08 15:09:50 vincentdarley Exp $
+# RCS: @(#) $Id: winFCmd.test,v 1.22 2003/09/16 14:56:08 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -606,8 +606,11 @@ test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {pcOnly 95} {
 } {1 {nul EACCES}}
 test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {pcOnly nt} {
     cleanup
-    list [catch {testfile rmdir /} msg] $msg
-} {1 {/ EACCES}}
+    set res [list [catch {testfile rmdir /} msg] $msg]
+    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
+    # decision has been made as to which is correct.
+    regsub {E(ACCES|EXIST)} $res "EACCES or EEXIST"
+} {1 {C:/ EACCES or EEXIST}}
 test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {pcOnly 95} {
     cleanup
     createfile tf1
@@ -982,6 +985,43 @@ test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} {
 test winFCmd-16.1 {Windows file normalization} {pcOnly} {
     list [file normalize c:/] [file normalize C:/]
 } {C:/ C:/}
+test winFCmd-16.2 {Windows file normalization} {pcOnly} {
+    close [open td1... w]
+    set res [file tail [file normalize td1]]
+    file delete td1...
+    set res
+} {td1}
+
+set pwd [pwd]
+set d [string index $pwd 0]
+
+test winFCmd-16.3 {Windows file normalization} {pcOnly} {
+    file norm ${d}:foo
+} [file join $pwd foo]
+test winFCmd-16.4 {Windows file normalization} {pcOnly} {
+    file norm [string tolower ${d}]:foo
+} [file join $pwd foo]
+test winFCmd-16.5 {Windows file normalization} {pcOnly} {
+    file norm ${d}:foo/bar
+} [file join $pwd foo/bar]
+test winFCmd-16.6 {Windows file normalization} {pcOnly} {
+    file norm ${d}:foo\\bar
+} [file join $pwd foo/bar]
+test winFCmd-16.7 {Windows file normalization} {pcOnly} {
+    file norm /bar
+} "${d}:/bar"
+test winFCmd-16.8 {Windows file normalization} {pcOnly} {
+    file norm ///bar
+} "${d}:/bar"
+test winFCmd-16.9 {Windows file normalization} {pcOnly} {
+    file norm /bar/foo
+} "${d}:/bar/foo"
+test winFCmd-16.10 {Windows file normalization} {pcOnly knownBug} {
+    if {$d eq "C"} { set dd "D" } else { set dd "C" }
+    file norm ${dd}:foo
+} {Tcl doesn't know about a drive-specific cwd}
+
+unset d pwd
 
 # This block of code used to occur after the "return" call, so I'm
 # commenting it out and assuming that this code is still under construction.