3414754 Fix the PATHFLAGS != 0 intrep normalizing trailing slashes.

4 files changed, 19 insertions, 31 deletions

diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index a8c4f42..26587ee 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -823,10 +823,11 @@ Tcl_FSJoinToPath(
 void
 TclpNativeJoinPath(
     Tcl_Obj *prefix,
-    char *joining)
+    const char *joining)
 {
     int length, needsSep;
-    char *dest, *p, *start;
+    const char *p;
+    char *dest, *start;
 
     start = Tcl_GetStringFromObj(prefix, &length);
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 854404f..e1ce6d5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2741,7 +2741,7 @@ MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,
 			    Tcl_DString *dirPtr, char *pattern, char *tail);
 MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
 			    Tcl_Obj *pathPtr, int nextCheckpoint);
-MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, char *joining);
+MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
 MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
 MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
 			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 8840e4a..eb19096 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1367,37 +1367,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 2acdbd2..b3a9aca 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -1094,6 +1094,10 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} {
     set res
 } {0 0 0 0 1}
 
+test filesystem-10.1 {Bug 3414754} {
+    string match */ [file join [pwd] foo/]
+} 0
+
 cleanupTests
 unset -nocomplain drive
 }