summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclPathObj.c81
-rw-r--r--tests/cmdAH.test7
-rw-r--r--tests/winFile.test6
-rw-r--r--tests/winPipe.test8
-rw-r--r--win/tclWinTest.c15
5 files changed, 71 insertions, 46 deletions
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 87ddfb7..d8be51a 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -29,6 +29,9 @@ static int IsSeparatorOrNull(int ch);
static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr);
static int MakePathFromNormalized(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
+static Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[],
+ int forceRelative);
+
/*
* Define the 'path' object type, which Tcl uses to represent file paths
@@ -821,15 +824,13 @@ GetExtension(
*---------------------------------------------------------------------------
*/
-Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
-
Tcl_Obj *
Tcl_FSJoinPath(
Tcl_Obj *listObj, /* Path elements to join, may have a zero
* reference count. */
int elements) /* Number of elements to use (-1 = all) */
{
- Tcl_Obj *copy, *res;
+ Tcl_Obj *res;
int objc;
Tcl_Obj **objv;
@@ -838,17 +839,17 @@ Tcl_FSJoinPath(
}
elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
- copy = TclListObjCopy(NULL, listObj);
Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
- res = TclJoinPath(elements, objv);
- Tcl_DecrRefCount(copy);
+ res = TclJoinPath(elements, objv, 0);
return res;
}
-Tcl_Obj *
+static Tcl_Obj *
TclJoinPath(
- int elements,
- Tcl_Obj * const objv[])
+ int elements, /* Number of elements to use (-1 = all) */
+ Tcl_Obj * const objv[], /* Path elements to join */
+ int forceRelative) /* If non-zero, assume all more paths are
+ * relative (e. g. simple normalization) */
{
Tcl_Obj *res = NULL; /* Resulting path object (container of join) */
Tcl_Obj *elt; /* Path part (result if returns part of path) */
@@ -875,13 +876,14 @@ TclJoinPath(
* to be an absolute path. Added a check for that elt is absolute.
*/
- if ((i == (elements-2)) && (i == 0)
+ if ((i == 0) && (elements == 2)
&& (elt->typePtr == &tclFsPathType)
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
Tcl_Obj *tailObj = objv[i+1];
-
- type = TclGetPathType(tailObj, NULL, NULL, NULL);
+ /* if forceRelative - second path is relative */
+ type = forceRelative ? TCL_PATH_RELATIVE :
+ TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
const char *str;
int len;
@@ -953,7 +955,9 @@ TclJoinPath(
}
strElt = Tcl_GetStringFromObj(elt, &strEltLen);
driveNameLength = 0;
- type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
+ /* if forceRelative - all paths excepting first one are relative */
+ type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE :
+ TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
if (type != TCL_PATH_RELATIVE) {
/*
* Zero out the current result.
@@ -2413,37 +2417,30 @@ SetFsPathFromAny(
* Handle tilde substitutions, if needed.
*/
- if (name[0] == '~') {
+ if (len && name[0] == '~') {
char *expandedUser;
Tcl_DString temp;
int split;
char separator = '/';
+ /*
+ * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc.
+ * split becomes value 1 for '~/...' as well as for '~'.
+ */
split = FindSplitPos(name, separator);
- if (split != len) {
- /*
- * We have multiple pieces '~user/foo/bar...'
- */
-
- name[split] = '\0';
- }
/*
* Do some tilde substitution.
*/
- if (name[1] == '\0') {
+ if (split == 1) {
/*
- * We have just '~'
+ * We have just '~' (or '~/...')
*/
const char *dir;
Tcl_DString dirString;
- if (split != len) {
- name[split] = separator;
- }
-
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
@@ -2461,22 +2458,24 @@ SetFsPathFromAny(
* We have a user name '~user'
*/
+ Tcl_DString userName;
+
+ Tcl_DStringInit(&userName);
+ Tcl_DStringAppend(&userName, name+1, split-1);
+ expandedUser = Tcl_DStringValue(&userName);
+
Tcl_DStringInit(&temp);
- if (TclpGetUserHome(name+1, &temp) == NULL) {
+ if (TclpGetUserHome(expandedUser, &temp) == NULL) {
if (interp != NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", name+1,
+ Tcl_AppendResult(interp, "user \"", expandedUser,
"\" doesn't exist", NULL);
}
+ Tcl_DStringFree(&userName);
Tcl_DStringFree(&temp);
- if (split != len) {
- name[split] = separator;
- }
return TCL_ERROR;
}
- if (split != len) {
- name[split] = separator;
- }
+ Tcl_DStringFree(&userName);
}
expandedUser = Tcl_DStringValue(&temp);
@@ -2514,14 +2513,18 @@ SetFsPathFromAny(
pair[0] = transPtr;
pair[1] = Tcl_NewStringObj(name+split+1, -1);
- transPtr = TclJoinPath(2, pair);
- TclDecrRefCount(pair[0]);
- TclDecrRefCount(pair[1]);
+ transPtr = TclJoinPath(2, pair, 1);
+ if (transPtr != pair[0]) {
+ TclDecrRefCount(pair[0]);
+ }
+ if (transPtr != pair[1]) {
+ TclDecrRefCount(pair[1]);
+ }
}
}
Tcl_DStringFree(&temp);
} else {
- transPtr = TclJoinPath(1, &pathPtr);
+ transPtr = TclJoinPath(1, &pathPtr, 1);
}
/*
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 6cc8c0f..516505c 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -541,6 +541,13 @@ test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
testsetplatform windows
file tail {foo\bar}
} bar
+test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} {
+ list \
+ [file tail {~/~foo}] \
+ [file tail {~/test/~foo}] \
+ [file tail [file normalize {~/~foo}]] \
+ [file tail [file normalize {~/test/~foo}]]
+} [lrepeat 4 ./~foo]
# rootname
diff --git a/tests/winFile.test b/tests/winFile.test
index bfba9cf..d586e06 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -60,13 +60,15 @@ test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
test winFile-2.1 {TclpMatchFiles: case sensitivity} {win} {
makeFile {} GlobCapS
- set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]]
+ set args [list -nocomplain -tails -directory [temporaryDirectory]]
+ set result [list [glob {*}$args GlobC*] [glob {*}$args globc*]]
removeFile GlobCapS
set result
} {GlobCapS GlobCapS}
test winFile-2.2 {TclpMatchFiles: case sensitivity} {win} {
makeFile {} globlower
- set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]]
+ set args [list -nocomplain -tails -directory [temporaryDirectory]]
+ set result [list [glob {*}$args globl*] [glob {*}$args gLOBl*]]
removeFile globlower
set result
} {globlower globlower}
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 6a02147..70d4843 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -17,9 +17,13 @@ namespace import -force ::tcltest::*
unset -nocomplain path
-set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
+set org_pwd [pwd]
+set bindir [file join $org_pwd [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]
+# several test-cases here expect current directory == [temporaryDirectory]:
+cd [temporaryDirectory]
+
testConstraint exec [llength [info commands exec]]
testConstraint testexcept [llength [info commands testexcept]]
testConstraint cat32 [file exists $cat32]
@@ -600,4 +604,6 @@ if {[catch {set env(TEMP) $env_temp}]} {
file delete big little stdout stderr nothing echoArgs.tcl echoArgs.bat
file delete -force [file join [temporaryDirectory] test(Dir)Check]
::tcltest::cleanupTests
+# back to original directory:
+cd $org_pwd; unset org_pwd
return
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 73f4e45..7f49b63 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -420,9 +420,11 @@ TestplatformChmod(
static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
| GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
+ /* don't deny DELETE mask (reset writable only, allow test-cases cleanup) */
static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
| FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
- | FILE_WRITE_DATA | DELETE;
+ | FILE_WRITE_DATA
+ /* | DELETE */;
/*
* References to security functions (only available on NT and later).
@@ -466,7 +468,10 @@ TestplatformChmod(
TCL_DECLARE_MUTEX(initializeMutex)
Tcl_MutexLock(&initializeMutex);
if (!initialized) {
- HMODULE handle = GetModuleHandle(TEXT("ADVAPI"));
+ HMODULE handle = GetModuleHandle(TEXT("ADVAPI32"));
+ if (handle == NULL) {
+ handle = GetModuleHandle(TEXT("ADVAPI"));
+ }
if (handle != NULL) {
setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
@@ -661,11 +666,13 @@ TestplatformChmod(
}
/*
- * Apply the new ACL.
+ * Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used
+ * to remove inherited ACL (we need to overwrite the default ACL's in this case)
*/
if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc(
- (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
+ (LPSTR) nativePath, SE_FILE_OBJECT,
+ DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
}
generated by cgit v0.12 at 2025-12-24 22:27:53 (GMT)