diff options
| -rw-r--r-- | generic/tclPathObj.c | 39 | ||||
| -rw-r--r-- | tests/fileSystem.test | 4 |
2 files changed, 15 insertions, 28 deletions
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 205c301..dd68004 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1369,37 +1369,20 @@ AppendPath( const char *bytes; Tcl_Obj *copy = Tcl_DuplicateObj(head); - bytes = Tcl_GetStringFromObj(copy, &numBytes); - /* - * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the - * Windows special case? Perhaps we should just check if cwd is a root - * volume. We should never get numBytes == 0 in this code path. + * This is likely buggy when dealing with virtual filesystem drivers + * that use some character other than "/" as a path separator. I know + * of no evidence that such a foolish thing exists. This solution was + * chosen so that "JoinPath" operations that pass through either path + * intrep produce the same results; that is, bugward compatibility. If + * we need to fix that bug here, it needs fixing in Tcl_FSJoinPath() too. */ - - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (bytes[numBytes-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - } - break; - - case TCL_PLATFORM_WINDOWS: - /* - * We need the extra 'numBytes != 2', and ':' checks because a volume - * relative path doesn't get a '/'. For example 'glob C:*cat*.exe' - * will return 'C:cat32.exe' - */ - - if (bytes[numBytes-1] != '/' && bytes[numBytes-1] != '\\') { - if (numBytes!= 2 || bytes[1] != ':') { - Tcl_AppendToObj(copy, "/", 1); - } - } - break; + bytes = Tcl_GetStringFromObj(tail, &numBytes); + if (numBytes == 0) { + Tcl_AppendToObj(copy, "/", 1); + } else { + TclpNativeJoinPath(copy, bytes); } - - Tcl_AppendObjToObj(copy, tail); return copy; } diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 4191713..9950dde 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -920,6 +920,10 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} -setup { # ---------------------------------------------------------------------- +test filesystem-10.1 {Bug 3414754} { + string match */ [file join [pwd] foo/] +} 0 + cleanupTests unset -nocomplain drive drives } |