summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclPathObj.c12
-rw-r--r--tests/fileSystem.test28
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}