diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 12 | ||||
| -rw-r--r-- | tests/fileSystem.test | 28 |
3 files changed, 40 insertions, 5 deletions
@@ -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} |