fixed another volume-relative file normalization problem

3 files changed, 28 insertions, 5 deletions

diff --git a/ChangeLog b/ChangeLog
index 1370670..62e7197 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,8 @@
 2004-03-26  Vince Darley  <vincentdarley@users.sourceforge.net>
 
         * generic/tclPathObj.c:   Fix to Windows-only volume relative
-        * tests/fileSystem.test:  path normalization. [Bug 923586]
+        * tests/fileSystem.test:  path normalization. [Bug 923586].
+        Also fixed another volume relative bug found while testing.
 
 2004-03-24  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 2be2a7e..6302660 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.26 2004/03/26 18:45:10 vincentdarley Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.27 2004/03/26 19:04:49 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1689,10 +1689,18 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
 		    }
 		    if (drive[0] == drive_cur) {
 			absolutePath = Tcl_DuplicateObj(useThisCwd);
-			/* We have a refCount on the cwd */
+			/* 
+			 * We have a refCount on the cwd, which we
+			 * will release later.
+			 */
 
-                        if (drive[cwdLen-1] != '/') {
-                            /* Only add a trailing '/' if needed */
+                        if (drive[cwdLen-1] != '/' && (path[2] != '\0')) {
+                            /* 
+                             * Only add a trailing '/' if needed, which
+                             * is if there isn't one already, and if we
+                             * are going to be adding some more
+                             * characters.
+                             */
                             Tcl_AppendToObj(absolutePath, "/", 1);
                         }
 		    } else {
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 281d8c9..5f8105d 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -386,6 +386,20 @@ test filesystem-1.38 {file normalisation with volume relative} \
     set res
 } "[lindex $drives 0]foo"
 
+test filesystem-1.39 {file normalisation with volume relative} {winOnly} {
+    set drv [lindex [file volumes] 0]
+    set dir [lindex [glob -type d -dir $drv *] 0]
+    set old [pwd]
+    cd $dir
+    set res [file norm [string range $drv 0 1]]
+    cd $old
+    if {[string index $res end] eq "/"} {
+        set res "Bad normalized path: $res"
+    } else {
+        set res "ok"
+    }
+} {ok}
+
 test filesystem-2.0 {new native path} {unixOnly} {
    foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
        catch {file readlink $f}