diff options
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 11 | ||||
-rw-r--r-- | tests/fileName.test | 9 |
3 files changed, 25 insertions, 2 deletions
@@ -1,3 +1,10 @@ +2009-02-20 Don Porter <dgp@users.sourceforge.net> + + * generic/tclPathObj.c: Fixed mistaken logic in TclFSGetPathType() + * tests/fileName.test: that assumed (not "absolute" => "relative"). + This is a false assumption on Windows, where "volumerelative" is + another possibility. [Bug 2571597]. + 2008-02-06 Daniel Steffen <das@users.sourceforge.net> * generic/tcl.h (Darwin): workaround conflict between deprecated tcl diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 82aa209..4d741b4 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.39 2008/12/04 17:43:53 dgp Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.40 2009/02/20 18:24:28 dgp Exp $ */ #include "tclInt.h" @@ -4747,7 +4747,16 @@ FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); if (fsPathPtr->cwdPtr != NULL) { if (PATHFLAGS(pathObjPtr) == 0) { + /* The path is not absolute... */ +#ifdef __WIN32__ + /* ... on Windows we must make another call to determine + * whether it's relative or volumerelative [Bug 2571597]. */ + return GetPathType(pathObjPtr, filesystemPtrPtr, + driveNameLengthPtr, NULL); +#else + /* On other systems, quickly deduce !absolute -> relative */ return TCL_PATH_RELATIVE; +#endif } return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, driveNameLengthPtr); diff --git a/tests/fileName.test b/tests/fileName.test index 138f5c6..6e9eb79 100644 --- a/tests/fileName.test +++ b/tests/fileName.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: fileName.test,v 1.30.2.9 2008/08/14 13:07:58 dgp Exp $ +# RCS: @(#) $Id: fileName.test,v 1.30.2.10 2009/02/20 18:24:28 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -2000,6 +2000,13 @@ test filename-17.2 {windows specific glob with executable} {winOnly} { removeDirectory execglob set res } {abc.exe} +test filename-17.3 {Bug 2571597} win { + set p /a + file pathtype $p + file normalize $p + file pathtype $p +} volumerelative + test fileName-18.1 {windows - split ADS name correctly} {winOnly} { # bug 1194458 |