diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 87 | ||||
| -rw-r--r-- | tests/fileName.test | 81 |
3 files changed, 139 insertions, 35 deletions
@@ -1,3 +1,9 @@ +2003-09-29 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tclPathObj.c: + * tests/fileName.test: fix to inconsistent handling of backslash + path separators on Windows in 'file join' [Bug 813273] + 2003-09-29 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclPathObj.c (TclNativePathInFilesystem,TclFSGetPathType): diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 7283608..a86eed8 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.9 2003/09/29 22:38:21 dkf Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.10 2003/09/30 14:05:44 vincentdarley Exp $ */ #include "tclInt.h" @@ -338,25 +338,34 @@ Tcl_FSJoinPath(listObj, elements) } } - if (elements == 2) { - /* - * This is a special case where we can be much more - * efficient - */ - Tcl_Obj *base; + res = Tcl_NewObj(); + + for (i = 0; i < elements; i++) { + Tcl_Obj *elt; + int driveNameLength; + Tcl_PathType type; + char *strElt; + int strEltLen; + int length; + char *ptr; + Tcl_Obj *driveName = NULL; + + Tcl_ListObjIndex(NULL, listObj, i, &elt); - Tcl_ListObjIndex(NULL, listObj, 0, &base); /* - * There is only any value in doing this if the first object is - * of path type, otherwise we'll never actually get any - * efficiency benefit elsewhere in the code (from re-using the - * normalized representation of the base object). + * This is a special case where we can be much more + * efficient, where we are joining a single relative path + * onto an object that is already of path type. The + * 'TclNewFSPathObj' call below creates an object which + * can be normalized more efficiently. Currently we only + * use the special case when we have exactly two elements, + * but we could expand that in the future. */ - if (base->typePtr == &tclFsPathType - && !(base->bytes != NULL && base->bytes[0] == '\0')) { + if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType) + && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) { Tcl_Obj *tail; Tcl_PathType type; - Tcl_ListObjIndex(NULL, listObj, 1, &tail); + Tcl_ListObjIndex(NULL, listObj, i+1, &tail); type = TclGetPathType(tail, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { CONST char *str; @@ -368,10 +377,20 @@ Tcl_FSJoinPath(listObj, elements) * '/'. There's no need to return a special path * object, when the base itself is just fine! */ - return base; + return elt; } - if (str[0] != '.') { - return TclNewFSPathObj(base, str, len); + /* + * If it doesn't begin with '.' and is a mac or unix + * path or it a windows path without backslashes, then we + * can be very efficient here. (In fact even a windows + * path with backslashes can be joined efficiently, but + * the path object would not have forward slashes only, + * and this would therefore contradict our 'file join' + * documentation). + */ + if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) + || (strchr(str, '\\') == NULL))) { + return TclNewFSPathObj(elt, str, len); } /* * Otherwise we don't have an easy join, and @@ -379,24 +398,24 @@ Tcl_FSJoinPath(listObj, elements) * things */ } else { - return tail; + if (tclPlatform == TCL_PLATFORM_UNIX) { + return tail; + } else { + CONST char *str; + int len; + str = Tcl_GetStringFromObj(tail,&len); + if (tclPlatform == TCL_PLATFORM_WINDOWS) { + if (strchr(str, '\\') == NULL) { + return tail; + } + } else if (tclPlatform == TCL_PLATFORM_MAC) { + if (strchr(str, '/') == NULL) { + return tail; + } + } + } } } - } - - res = Tcl_NewObj(); - - for (i = 0; i < elements; i++) { - Tcl_Obj *elt; - int driveNameLength; - Tcl_PathType type; - char *strElt; - int strEltLen; - int length; - char *ptr; - Tcl_Obj *driveName = NULL; - - Tcl_ListObjIndex(NULL, listObj, i, &elt); strElt = Tcl_GetStringFromObj(elt, &strEltLen); type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { diff --git a/tests/fileName.test b/tests/fileName.test index 3dce4c5..de5c655 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.31 2003/04/25 18:28:42 vincentdarley Exp $ +# RCS: @(#) $Id: fileName.test,v 1.32 2003/09/30 14:05:45 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -25,6 +25,14 @@ if {[tcltest::testConstraint testsetplatform]} { set platform [testgetplatform] } +# Caution: when using 'testsetplatform' to test different file +# name platform descriptions in this file, one must be very +# careful not to combine such platform manipulation with +# commands like 'cd', 'pwd'. That is because the latter commands +# operate on the real filesystem but will potentially have their +# logic routed through the wrong generic code paths if we've +# used 'testsetplatform'. This can lead to serious problems, +# even crashes. test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype / @@ -895,6 +903,74 @@ test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo/./bar } {foo/./bar} +test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} { + testsetplatform win + set res {} + lappend res \ + [file join {C:\foo\bar}] \ + [file join C:/blah {C:\foo\bar}] \ + [file join C:/blah C:/blah {C:\foo\bar}] +} {C:/foo/bar C:/foo/bar C:/foo/bar} +test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} { + testsetplatform unix + set res {} + lappend res \ + [file join {/foo/bar}] \ + [file join /x {/foo/bar}] \ + [file join /x /x {/foo/bar}] +} {/foo/bar /foo/bar /foo/bar} +test filename-9.21 {Tcl_JoinPath: mac} {testsetplatform} { + testsetplatform mac + set res {} + lappend res \ + [file join {/foo/bar}] \ + [file join drive: {/foo/bar}] \ + [file join drive: drive: {/foo/bar}] +} {foo:bar foo:bar foo:bar} +test filename-9.22 {Tcl_JoinPath: mac} {testsetplatform} { + testsetplatform mac + set res {} + lappend res \ + [file join {foo:bar}] \ + [file join drive: {foo:bar}] \ + [file join drive: drive: {foo:bar}] +} {foo:bar foo:bar foo:bar} +test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} { + testsetplatform win + set res {} + lappend res \ + [file join {foo\bar}] \ + [file join C:/blah {foo\bar}] \ + [file join C:/blah C:/blah {foo\bar}] + string map [list C:/blah ""] $res +} {foo/bar /foo/bar /foo/bar} +test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} { + testsetplatform unix + set res {} + lappend res \ + [file join {foo/bar}] \ + [file join /x {foo/bar}] \ + [file join /x /x {foo/bar}] + string map [list /x ""] $res +} {foo/bar /foo/bar /foo/bar} +test filename-9.25 {Tcl_JoinPath: mac} {testsetplatform} { + testsetplatform mac + set res {} + lappend res \ + [file join {foo/bar}] \ + [file join drive: {foo/bar}] \ + [file join drive: drive: {foo/bar}] + string map [list drive: ""] $res +} {:foo:bar foo:bar foo:bar} +test filename-9.26 {Tcl_JoinPath: mac} {testsetplatform} { + testsetplatform mac + set res {} + lappend res \ + [file join {:foo:bar}] \ + [file join drive: {:foo:bar}] \ + [file join drive: drive: {:foo:bar}] + string map [list drive: ""] $res +} {:foo:bar foo:bar foo:bar} test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform unix @@ -1870,6 +1946,9 @@ test filename-17.1 {windows specific special files} {testsetplatform} { [file pathtype prn] [file pathtype nul] [file pathtype aux] \ [file pathtype foo] } {absolute absolute absolute absolute absolute absolute relative} +if {[tcltest::testConstraint testsetplatform]} { + testsetplatform $platform +} test filename-17.2 {windows specific glob with executable} {winOnly} { makeDirectory execglob |