tcltk/tcl
1
0
Fork 0
mirror of https://github.com/tcltk/tcl.git synced 2026-05-29 00:27:49 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge 9.0 - Bug [1215dca7] - inconsistent file join with volume relative arguments

Browse Source
This commit is contained in:
apnadkarni
2026-05-25 10:08:54 +00:00
parent 9642199be4 48da715792
commit 2e28014149
3 changed files with 49 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
generic/tclIOUtil.c
View File

@@ -3914,10 +3914,11 @@ TclGetPathType(
type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
driveNameLengthPtr, driveNameRef);
if (type != TCL_PATH_ABSOLUTE) {
if (type == TCL_PATH_RELATIVE) {
type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
driveNameRef);
if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
/* Bug 1215dca78f - If not relative, need to update owning FS. */
if ((type != TCL_PATH_RELATIVE) && (filesystemPtrPtr != NULL)) {
*filesystemPtrPtr = &tclNativeFilesystem;
}
}
@@ -4012,6 +4013,7 @@ TclFSNonnativePathType(
Tcl_Obj *vol;
Tcl_Size len;
const char *strVol;
bool matched = false;
numVolumes--;
Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
@@ -4021,6 +4023,16 @@ TclFSNonnativePathType(
}
if (strncmp(strVol, path, len) == 0) {
type = TCL_PATH_ABSOLUTE;
matched = true;
} else if (len > 2 && strVol[len - 1] == '/' &&
strVol[len - 2] == ':' &&
strncmp(strVol, path, len - 2) == 0) {
matched = true;
type = TCL_PATH_VOLUME_RELATIVE;
len--;
Tcl_SetObjLength(vol, len);
}
if (matched) {
if (filesystemPtrPtr != NULL) {
*filesystemPtrPtr = fsRecPtr->fsPtr;
}
@@ -4035,7 +4047,7 @@ TclFSNonnativePathType(
}
}
Tcl_DecrRefCount(thisFsVolumes);
if (type == TCL_PATH_ABSOLUTE) {
if (type != TCL_PATH_RELATIVE) {
/*
* No need to examine additional filesystems.
*/

10
generic/tclPathObj.c
View File

@@ -1088,7 +1088,15 @@ TclJoinPath(
}
}
if (length > 0 && ptr[length -1] != '/') {
/*
* The check against //zipfs: is required when joining relative
* zipfs paths. For example, [file join c:/ //zipfs:foo]. See
* [1215dca7] or tests filename-9.25.{3,4}. Unfortunately, bit
* of a hack but Tcl lacks VFS abstractions to generalize this.
* Happy to be proven wrong.
*/
if (length > 0 && ptr[length - 1] != '/' &&
(length != 8 || strcmp(ptr, "//zipfs:"))) {
Tcl_AppendToObj(res, &separator, 1);
(void)TclGetStringFromObj(res, &length);
}

25
tests/fileName.test
View File

@@ -576,6 +576,31 @@ test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} {
[file join /x /x {foo/bar}]
string map [list /x ""] $res
} {foo/bar /foo/bar /foo/bar}
test filename-9.25.1 {
Bug 1215dc - Inconsistent file join with volume relative arguments: unix
} -constraints testsetplatform -body {
testsetplatform unix
file join //zipfs:/foo c:bar
} -result "//zipfs:/foo/c:bar"
test filename-9.25.2 {
Bug 1215dc - Inconsistent file join with volume relative arguments: win
} -constraints testsetplatform -body {
testsetplatform win
file join //zipfs:/foo c:bar
} -result "c:bar"
test filename-9.25.3 {
Bug 1215dc - Inconsistent file join with volume relative arguments: unix,zipfs
} -constraints testsetplatform -body {
testsetplatform unix
file join / //zipfs:foo
} -result "//zipfs:foo"
test filename-9.25.4 {
Bug 1215dc - Inconsistent file join with volume relative arguments: win,zipfs
} -constraints testsetplatform -body {
testsetplatform win
file join C:\\ //zipfs:foo
} -result "//zipfs:foo"
test filename-10.1 {Tcl_TranslateFileName} -body {
testsetplatform unix