From dbf0dda330688becb98f2c5eb2e87878f80487cf Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Fri, 26 Mar 2004 18:45:09 +0000
Subject: fix to windows volume-relative path normalization

---
 ChangeLog             |  5 +++++
 generic/tclPathObj.c  | 12 +++++++-----
 tests/fileSystem.test | 28 ++++++++++++++++++++++++++++
 3 files changed, 40 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 1ecf806..1370670 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +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]
+
 2004-03-24  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* generic/tclNamesp.c (NsEnsembleImplementationCmd): Fix messed up
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index cd3f9f9..2be2a7e 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.25 2004/03/17 18:14:14 das Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.26 2004/03/26 18:45:10 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1690,6 +1690,11 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
 		    if (drive[0] == drive_cur) {
 			absolutePath = Tcl_DuplicateObj(useThisCwd);
 			/* We have a refCount on the cwd */
+
+                        if (drive[cwdLen-1] != '/') {
+                            /* Only add a trailing '/' if needed */
+                            Tcl_AppendToObj(absolutePath, "/", 1);
+                        }
 		    } else {
 			Tcl_DecrRefCount(useThisCwd);
 			useThisCwd = NULL;
@@ -1701,12 +1706,9 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
 			 * therefore behave the same here.
 			 */
 			absolutePath = Tcl_NewStringObj(path, 2);
+                        Tcl_AppendToObj(absolutePath, "/", 1);
 		    }
 		    Tcl_IncrRefCount(absolutePath);
-		    if (drive[cwdLen-1] != '/') {
-			/* Only add a trailing '/' if needed */
-		        Tcl_AppendToObj(absolutePath, "/", 1);
-		    }
 		    Tcl_AppendToObj(absolutePath, path+2, -1);
 		}
 #endif /* __WIN32__ */
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 964f201..281d8c9 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -47,6 +47,24 @@ if {$::tcl_platform(platform) eq "windows"} {
     # The variable 'drive' will be used below
 }
 
+tcltest::testConstraint moreThanOneDrive 0
+set drives [list]
+if {$::tcl_platform(platform) eq "windows"} {
+    set dir [pwd]
+    foreach vol [file volumes] {
+        if {![catch {cd $vol}]} {
+            lappend drives $vol
+        }
+    }
+    if {[llength $drives] > 1} {
+        tcltest::testConstraint moreThanOneDrive 1
+    }
+    # The variable 'drives' will be used below
+    unset vol
+    cd $dir
+    unset dir
+}
+
 proc testPathEqual {one two} {
     if {[string equal $one $two]} {
 	return 1
@@ -358,6 +376,16 @@ test filesystem-1.37 {file normalisation with '/./'} {
     set res
 } {ok}
 
+test filesystem-1.38 {file normalisation with volume relative} \
+  {winOnly moreThanOneDrive} {
+    set path "[string range [lindex $drives 0] 0 1]foo"
+    set dir [pwd]
+    cd [lindex $drives 1]
+    set res [file norm $path]
+    cd $dir
+    set res
+} "[lindex $drives 0]foo"
+
 test filesystem-2.0 {new native path} {unixOnly} {
    foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
        catch {file readlink $f}
-- 
cgit v0.12