Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge 8.7 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
fbd86fde020a99734962210891cacc1e |
| User & Date: | sebres 2018-11-22 14:30:22 |
Context
|
2018-11-22
| ||
| 14:45 | merge 8.7 check-in: 6e3fdcb567 user: sebres tags: trunk | |
| 14:30 | merge 8.7 check-in: fbd86fde02 user: sebres tags: trunk | |
| 14:16 | merge 8.6 check-in: 80652194d5 user: sebres tags: core-8-branch | |
| 09:26 | Eliminate gcc compiler warning check-in: d880a75ac5 user: jan.nijtmans tags: trunk | |
Changes
Changes to generic/tclCmdAH.c.
1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 |
int objc,
Tcl_Obj *const objv[])
{
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* PathNativeNameCmd --
|
| |
1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 |
int objc,
Tcl_Obj *const objv[])
{
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1, 0));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* PathNativeNameCmd --
|
Changes to generic/tclFCmd.c.
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 |
source = FileBasename(interp, objv[i]);
if (source == NULL) {
result = TCL_ERROR;
break;
}
jargv[0] = objv[objc - 1];
jargv[1] = source;
newFileName = TclJoinPath(2, jargv);
Tcl_IncrRefCount(newFileName);
result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
force);
Tcl_DecrRefCount(newFileName);
Tcl_DecrRefCount(source);
if (result == TCL_ERROR) {
|
| |
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 |
source = FileBasename(interp, objv[i]);
if (source == NULL) {
result = TCL_ERROR;
break;
}
jargv[0] = objv[objc - 1];
jargv[1] = source;
newFileName = TclJoinPath(2, jargv, 1);
Tcl_IncrRefCount(newFileName);
result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
force);
Tcl_DecrRefCount(newFileName);
Tcl_DecrRefCount(source);
if (result == TCL_ERROR) {
|
Changes to generic/tclFileName.c.
804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 |
Tcl_Obj *
Tcl_FSJoinToPath(
Tcl_Obj *pathPtr, /* Valid path or NULL. */
int objc, /* Number of array elements to join */
Tcl_Obj *const objv[]) /* Path elements to join. */
{
if (pathPtr == NULL) {
return TclJoinPath(objc, objv);
}
if (objc == 0) {
return TclJoinPath(1, &pathPtr);
}
if (objc == 1) {
Tcl_Obj *pair[2];
pair[0] = pathPtr;
pair[1] = objv[0];
return TclJoinPath(2, pair);
} else {
int elemc = objc + 1;
Tcl_Obj *ret, **elemv = Tcl_Alloc(elemc*sizeof(Tcl_Obj *));
elemv[0] = pathPtr;
memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
ret = TclJoinPath(elemc, elemv);
Tcl_Free(elemv);
return ret;
}
}
/*
*---------------------------------------------------------------------------
|
| | | | |
804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 |
Tcl_Obj *
Tcl_FSJoinToPath(
Tcl_Obj *pathPtr, /* Valid path or NULL. */
int objc, /* Number of array elements to join */
Tcl_Obj *const objv[]) /* Path elements to join. */
{
if (pathPtr == NULL) {
return TclJoinPath(objc, objv, 0);
}
if (objc == 0) {
return TclJoinPath(1, &pathPtr, 0);
}
if (objc == 1) {
Tcl_Obj *pair[2];
pair[0] = pathPtr;
pair[1] = objv[0];
return TclJoinPath(2, pair, 0);
} else {
int elemc = objc + 1;
Tcl_Obj *ret, **elemv = Tcl_Alloc(elemc*sizeof(Tcl_Obj *));
elemv[0] = pathPtr;
memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
ret = TclJoinPath(elemc, elemv, 0);
Tcl_Free(elemv);
return ret;
}
}
/*
*---------------------------------------------------------------------------
|
Changes to generic/tclInt.h.
3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 |
MODULE_SCOPE void TclInitNamespaceSubsystem(void);
MODULE_SCOPE void TclInitNotifier(void);
MODULE_SCOPE void TclInitObjSubsystem(void);
MODULE_SCOPE void TclInitSubsystems(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int TclIsSpaceProc(char byte);
MODULE_SCOPE int TclIsBareword(char byte);
MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
int indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
|
| > |
3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 |
MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(char byte); MODULE_SCOPE int TclIsBareword(char byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *const indexArray[]); /* TIP #280 */ |
Changes to generic/tclPathObj.c.
821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 ... 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 ... 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 .... 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 .... 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 .... 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 |
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;
int objc;
Tcl_Obj **objv;
if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
return NULL;
}
elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
copy = TclListObjCopy(NULL, listObj);
Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
res = TclJoinPath(elements, objv);
Tcl_DecrRefCount(copy);
return res;
}
Tcl_Obj *
TclJoinPath(
int elements,
Tcl_Obj * const objv[])
{
Tcl_Obj *res = NULL;
int i;
const Tcl_Filesystem *fsPtr = NULL;
assert ( elements >= 0 );
................................................................................
*
* Bugfix [a47641a0]. TclNewFSPathObj requires first argument
* to be an absolute path. Added a check for that elt is absolute.
*/
if ((eltIr)
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
Tcl_Obj *tailObj = objv[1];
Tcl_PathType type = TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
const char *str;
size_t len;
str = TclGetStringFromObj(tailObj, &len);
if (len == 0) {
/*
................................................................................
Tcl_PathType type;
char *strElt, *ptr;
Tcl_Obj *driveName = NULL;
Tcl_Obj *elt = objv[i];
strElt = TclGetStringFromObj(elt, &strEltLen);
driveNameLength = 0;
type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
if (type != TCL_PATH_RELATIVE) {
/*
* Zero out the current result.
*/
if (res != NULL) {
TclDecrRefCount(res);
................................................................................
name = TclGetStringFromObj(pathPtr, &len);
/*
* Handle tilde substitutions, if needed.
*/
if (name[0] == '~') {
Tcl_DString temp;
size_t split;
char separator = '/';
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') {
/*
* We have just '~'
*/
const char *dir;
Tcl_DString dirString;
if (split != len) {
name[split] = separator;
}
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"couldn't find HOME environment variable to"
" expand path", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
................................................................................
Tcl_JoinPath(1, &dir, &temp);
Tcl_DStringFree(&dirString);
} else {
/*
* We have a user name '~user'
*/
Tcl_DStringInit(&temp);
if (TclpGetUserHome(name+1, &temp) == NULL) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"user \"%s\" doesn't exist", name+1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
NULL);
}
Tcl_DStringFree(&temp);
if (split != len) {
name[split] = separator;
}
return TCL_ERROR;
}
if (split != len) {
name[split] = separator;
}
}
transPtr = TclDStringToObj(&temp);
if (split != len) {
/*
* Join up the tilde substitution with the rest.
................................................................................
}
TclDecrRefCount(parts);
} else {
Tcl_Obj *pair[2];
pair[0] = transPtr;
pair[1] = Tcl_NewStringObj(name+split+1, -1);
transPtr = TclJoinPath(2, pair);
Tcl_DecrRefCount(pair[0]);
Tcl_DecrRefCount(pair[1]);
}
}
} else {
transPtr = TclJoinPath(1, &pathPtr);
}
/*
* Now we have a translated filename in 'transPtr'. This will have forward
* slashes on Windows, and will not contain any ~user sequences.
*/
|
| < | < | | > > | | | > > > > > | | < < | < > > | < < < > | | < < < < > > > > > > > | | > < < < < < < > | > | > > | > | |
821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 ... 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 ... 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 .... 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 .... 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 .... 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 |
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 *res;
int objc;
Tcl_Obj **objv;
if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
return NULL;
}
elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
res = TclJoinPath(elements, objv, 0);
return res;
}
Tcl_Obj *
TclJoinPath(
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;
int i;
const Tcl_Filesystem *fsPtr = NULL;
assert ( elements >= 0 );
................................................................................
*
* Bugfix [a47641a0]. TclNewFSPathObj requires first argument
* to be an absolute path. Added a check for that elt is absolute.
*/
if ((eltIr)
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
Tcl_Obj *tailObj = objv[1];
Tcl_PathType type;
/* if forceRelative - second path is relative */
type = forceRelative ? TCL_PATH_RELATIVE :
TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
const char *str;
size_t len;
str = TclGetStringFromObj(tailObj, &len);
if (len == 0) {
/*
................................................................................
Tcl_PathType type;
char *strElt, *ptr;
Tcl_Obj *driveName = NULL;
Tcl_Obj *elt = objv[i];
strElt = TclGetStringFromObj(elt, &strEltLen);
driveNameLength = 0;
/* 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.
*/
if (res != NULL) {
TclDecrRefCount(res);
................................................................................
name = TclGetStringFromObj(pathPtr, &len);
/*
* Handle tilde substitutions, if needed.
*/
if (len && name[0] == '~') {
Tcl_DString temp;
size_t 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);
/*
* Do some tilde substitution.
*/
if (split == 1) {
/*
* We have just '~' (or '~/...')
*/
const char *dir;
Tcl_DString dirString;
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"couldn't find HOME environment variable to"
" expand path", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
................................................................................
Tcl_JoinPath(1, &dir, &temp);
Tcl_DStringFree(&dirString);
} else {
/*
* We have a user name '~user'
*/
const char *expandedUser;
Tcl_DString userName;
Tcl_DStringInit(&userName);
Tcl_DStringAppend(&userName, name+1, split-1);
expandedUser = Tcl_DStringValue(&userName);
Tcl_DStringInit(&temp);
if (TclpGetUserHome(expandedUser, &temp) == NULL) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"user \"%s\" doesn't exist", expandedUser));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
NULL);
}
Tcl_DStringFree(&userName);
Tcl_DStringFree(&temp);
return TCL_ERROR;
}
Tcl_DStringFree(&userName);
}
transPtr = TclDStringToObj(&temp);
if (split != len) {
/*
* Join up the tilde substitution with the rest.
................................................................................
}
TclDecrRefCount(parts);
} else {
Tcl_Obj *pair[2];
pair[0] = transPtr;
pair[1] = Tcl_NewStringObj(name+split+1, -1);
transPtr = TclJoinPath(2, pair, 1);
if (transPtr != pair[0]) {
Tcl_DecrRefCount(pair[0]);
}
if (transPtr != pair[1]) {
Tcl_DecrRefCount(pair[1]);
}
}
}
} else {
transPtr = TclJoinPath(1, &pathPtr, 1);
}
/*
* Now we have a translated filename in 'transPtr'. This will have forward
* slashes on Windows, and will not contain any ~user sequences.
*/
|
Changes to generic/tclZipfs.c.
4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 |
}
}
if (!objs[0]) {
objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
TCL_PATH_DIRNAME);
}
if (objs[0]) {
altPath = TclJoinPath(2, objs);
if (altPath) {
Tcl_IncrRefCount(altPath);
if (Tcl_FSAccess(altPath, R_OK) == 0) {
path = altPath;
}
}
}
|
| |
4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 |
}
}
if (!objs[0]) {
objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
TCL_PATH_DIRNAME);
}
if (objs[0]) {
altPath = TclJoinPath(2, objs, 0);
if (altPath) {
Tcl_IncrRefCount(altPath);
if (Tcl_FSAccess(altPath, R_OK) == 0) {
path = altPath;
}
}
}
|
Changes to tests/cmdAH.test.
562 563 564 565 566 567 568 569 570 571 572 573 574 575 |
testsetplatform windows
file tail {c:/foo\bar}
} bar
test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
testsetplatform windows
file tail {foo\bar}
} bar
# rootname
test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body {
file rootname a b
} -result {wrong # args: should be "file rootname name"}
test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform {
testsetplatform unix
|
> > > > > > > |
562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 |
testsetplatform windows
file tail {c:/foo\bar}
} bar
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
test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body {
file rootname a b
} -result {wrong # args: should be "file rootname name"}
test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform {
testsetplatform unix
|
Changes to tests/winFile.test.
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 |
} -match glob -result *
test winFile-1.4 {TclpGetUserHome} {win nonPortable} {
catch {glob [email protected]}
} {0}
test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
makeFile {} GlobCapS
list [glob -nocomplain GlobC*] [glob -nocomplain globc*]
} -cleanup {
removeFile GlobCapS
} -result {GlobCapS GlobCapS}
test winFile-2.2 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
makeFile {} globlower
list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]
} -cleanup {
removeFile globlower
} -result {globlower globlower}
test winFile-3.1 {file system} -constraints {win testvolumetype} -setup {
set res ""
} -body {
|
| | | > |
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
} -match glob -result *
test winFile-1.4 {TclpGetUserHome} {win nonPortable} {
catch {glob [email protected]}
} {0}
test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
makeFile {} GlobCapS
set args [list -nocomplain -tails -directory [temporaryDirectory]]
list [glob {*}$args GlobC*] [glob {*}$args globc*]} -cleanup {
removeFile GlobCapS
} -result {GlobCapS GlobCapS}
test winFile-2.2 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
makeFile {} globlower
set args [list -nocomplain -tails -directory [temporaryDirectory]]
list [glob {*}$args globl*] [glob {*}$args gLOBl*]
} -cleanup {
removeFile globlower
} -result {globlower globlower}
test winFile-3.1 {file system} -constraints {win testvolumetype} -setup {
set res ""
} -body {
|
Changes to tests/winPipe.test.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
...
604
605
606
607
608
609
610
611
612
613
614
615
|
catch {
::tcltest::loadTestedCommands
package require -exact Tcltest [info patchlevel]
set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}
set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]
testConstraint exec [llength [info commands exec]]
testConstraint cat32 [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole [expr {![testConstraint AllocConsole]}]
testConstraint testexcept [llength [info commands testexcept]]
testConstraint slowTest 0
................................................................................
removeFile stdout
removeFile stderr
removeFile nothing
if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl }
if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat }
if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check }
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
>
|
>
>
>
>
>
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
...
608
609
610
611
612
613
614
615
616
617
618
619
620
621
|
catch {
::tcltest::loadTestedCommands
package require -exact Tcltest [info patchlevel]
set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}
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 cat32 [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole [expr {![testConstraint AllocConsole]}]
testConstraint testexcept [llength [info commands testexcept]]
testConstraint slowTest 0
................................................................................
removeFile stdout
removeFile stderr
removeFile nothing
if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl }
if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat }
if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check }
::tcltest::cleanupTests
# back to original directory:
cd $org_pwd; unset org_pwd
return
# Local Variables:
# mode: tcl
# End:
|
Changes to win/tclWinTest.c.
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
...
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
|
static int
TestplatformChmod(
const char *nativePath,
int pmode)
{
static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
| GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
| FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
| FILE_WRITE_DATA | DELETE;
/*
* References to security functions (only available on NT and later).
*/
const BOOL set_readOnly = !(pmode & 0222);
BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted;
................................................................................
if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
((PACE_HEADER) pACE2)->AceSize)) {
goto done;
}
}
/*
* Apply the new ACL.
*/
if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
(LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
}
done:
if (secDesc) {
Tcl_Free(secDesc);
|
>
|
>
|
>
|
>
|
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
...
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
|
static int
TestplatformChmod(
const char *nativePath,
int pmode)
{
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 */;
/*
* References to security functions (only available on NT and later).
*/
const BOOL set_readOnly = !(pmode & 0222);
BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted;
................................................................................
if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
((PACE_HEADER) pACE2)->AceSize)) {
goto done;
}
}
/*
* 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 || SetNamedSecurityInfoA(
(LPSTR) nativePath, SE_FILE_OBJECT,
DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
}
done:
if (secDesc) {
Tcl_Free(secDesc);
|