diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tclTest.c | 65 | ||||
| -rw-r--r-- | tests/fCmd.test | 35 | ||||
| -rwxr-xr-x | tests/tcltest.test | 3 | ||||
| -rw-r--r-- | tests/winFCmd.test | 10 | ||||
| -rw-r--r-- | unix/tclUnixTest.c | 65 | ||||
| -rw-r--r-- | win/tclWinFile.c | 7 |
7 files changed, 117 insertions, 78 deletions
@@ -1,3 +1,13 @@ +2006-03-18 Vince Darley <vincentdarley@sourceforge.net> + + * generic/tclTest.c: + * win/tclWinFile.c: + * win/tclWinTest.c: + * tests/fCmd.test: + * tests/winFCmd.test: + * tests/tcltest.test: Backport of [file writable] fixes for + Windows from HEAD. [Bug 1193497] + 2006-03-16 Andreas Kupries <andreask@activestate.com> * doc/open.n: Documented the changed behaviour of 'a'ppend mode. diff --git a/generic/tclTest.c b/generic/tclTest.c index 59c3148..52ab14e 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.62.2.11 2005/12/15 04:08:26 das Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.62.2.12 2006/03/19 22:47:29 vincentdarley Exp $ */ #define TCL_TEST @@ -208,8 +208,6 @@ static int TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdcallCmd _ANSI_ARGS_((ClientData dummy, @@ -581,8 +579,6 @@ Tcltest_Init(interp) (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0, @@ -3999,65 +3995,6 @@ TestpanicCmd(dummy, interp, argc, argv) return TCL_OK; } -/* - *--------------------------------------------------------------------------- - * - * TestchmodCmd -- - * - * Implements the "testchmod" cmd. Used when testing "file" - * command. The only attribute used by the Mac and Windows platforms - * is the user write flag; if this is not set, the file is - * made read-only. Otehrwise, the file is made read-write. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Changes permissions of specified files. - * - *--------------------------------------------------------------------------- - */ - -static int -TestchmodCmd(dummy, interp, argc, argv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ -{ - int i, mode; - char *rest; - - if (argc < 2) { - usage: - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " mode file ?file ...?", (char *) NULL); - return TCL_ERROR; - } - - mode = (int) strtol(argv[1], &rest, 8); - if ((rest == argv[1]) || (*rest != '\0')) { - goto usage; - } - - for (i = 2; i < argc; i++) { - Tcl_DString buffer; - CONST char *translated; - - translated = Tcl_TranslateFileName(interp, argv[i], &buffer); - if (translated == NULL) { - return TCL_ERROR; - } - if (chmod(translated, (unsigned) mode) != 0) { - Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), - (char *) NULL); - return TCL_ERROR; - } - Tcl_DStringFree(&buffer); - } - return TCL_OK; -} - static int TestfileCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ diff --git a/tests/fCmd.test b/tests/fCmd.test index cb6d200..c53f8d4 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fCmd.test,v 1.26.2.7 2005/10/07 22:35:03 hobbs Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.26.2.8 2006/03/19 22:47:30 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -20,6 +20,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]] tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]] +testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}] +testConstraint 2000orNewer [expr {![testConstraint 95or98]}] # Several tests require need to match results against the unix username set user {} @@ -890,7 +892,7 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} file copy tf2 tf4 list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] } {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} -test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc testchmod} { +test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 95or98 testchmod} { cleanup file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] @@ -905,6 +907,20 @@ test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc tes } set msg } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}] +test fCmd-10.3.1 {file copy: comprehensive: dir to new name} {notRoot pc 2000orNewer testchmod} { + # On Windows with ACLs, copying a directory is defined like this + cleanup + file mkdir [file join td1 tdx] + file mkdir [file join td2 tdy] + testchmod 555 td2 + file copy td1 td3 + file copy td2 td4 + set msg [list [lsort [glob td*]] [glob -directory td3 t*] \ + [glob -directory td4 t*] [file writable td3] [file writable td4]] + testchmod 755 td2 + testchmod 755 td4 + set msg +} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1}] test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} { cleanup createfile tf1 @@ -977,7 +993,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot t [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] } [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \ - {notRoot unixOrPc testchmod} { + {notRoot unixOrPc 95or98 testchmod} { cleanup file mkdir td1 file mkdir td2 @@ -988,6 +1004,19 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \ list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] [file writable [file join td3 td4]] } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}] +test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} \ + {notRoot pc 2000orNewer testchmod} { + # On Windows with ACLs, copying a directory is defined like this + cleanup + file mkdir td1 + file mkdir td2 + file mkdir td3 + testchmod 555 td2 + file copy td1 [file join td3 td3] + file copy td2 [file join td3 td4] + list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ + [file writable [file join td3 td3]] [file writable [file join td3 td4]] +} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}] test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \ {notRoot} { cleanup diff --git a/tests/tcltest.test b/tests/tcltest.test index 7d3b1c4..c40826b 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -6,7 +6,7 @@ # Copyright (c) 2000 by Ajuba Solutions # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.37.2.10 2005/02/25 22:37:52 dgp Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.37.2.11 2006/03/19 22:47:30 vincentdarley Exp $ # Note that there are several places where the value of # tcltest::currentFailure is stored/reset in the -setup/-cleanup @@ -558,6 +558,7 @@ switch $tcl_platform(platform) { } default { catch {file attributes $notWriteableDir -readonly 1} + catch {testchmod 000 $notWriteableDir} } } diff --git a/tests/winFCmd.test b/tests/winFCmd.test index a6221c4..159317b 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winFCmd.test,v 1.20.2.8 2005/03/15 22:10:58 vincentdarley Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.20.2.9 2006/03/19 22:47:30 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -688,11 +688,11 @@ test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \ test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {pcOnly} { cleanup file mkdir td1 - testchmod 000 td1 createfile td1/tf1 tf1 + testchmod 000 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] -} {1 0} +} {1 1} test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {pcOnly} { cleanup file mkdir td1 @@ -744,11 +744,11 @@ test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} \ test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {pcOnly} { cleanup file mkdir td1 - testchmod 000 td1 createfile td1/tf1 tf1 + testchmod 000 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] -} {1 0} +} {1 1} test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} \ {pcOnly} { cleanup diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index e4c5662..905a986 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixTest.c,v 1.14.2.1 2003/10/13 01:00:38 hobbs Exp $ + * RCS: @(#) $Id: tclUnixTest.c,v 1.14.2.2 2006/03/19 22:47:30 vincentdarley Exp $ */ #include "tclInt.h" @@ -83,6 +83,8 @@ static int TestalarmCmd _ANSI_ARGS_((ClientData dummy, static int TestgotsigCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static void AlarmHandler _ANSI_ARGS_(()); +static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv)); /* *---------------------------------------------------------------------- @@ -105,6 +107,8 @@ int TclplatformtestInit(interp) Tcl_Interp *interp; /* Interpreter to add commands to. */ { + Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, @@ -703,3 +707,62 @@ TestgotsigCmd(clientData, interp, argc, argv) gotsig = "0"; return TCL_OK; } + +/* + *--------------------------------------------------------------------------- + * + * TestchmodCmd -- + * + * Implements the "testchmod" cmd. Used when testing "file" command. + * The only attribute used by the Windows platform is the user write + * flag; if this is not set, the file is made read-only. Otehrwise, the + * file is made read-write. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Changes permissions of specified files. + * + *--------------------------------------------------------------------------- + */ + +static int +TestchmodCmd(dummy, interp, argc, argv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + CONST char **argv; /* Argument strings. */ +{ + int i, mode; + char *rest; + + if (argc < 2) { + usage: + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " mode file ?file ...?", NULL); + return TCL_ERROR; + } + + mode = (int) strtol(argv[1], &rest, 8); + if ((rest == argv[1]) || (*rest != '\0')) { + goto usage; + } + + for (i = 2; i < argc; i++) { + Tcl_DString buffer; + CONST char *translated; + + translated = Tcl_TranslateFileName(interp, argv[i], &buffer); + if (translated == NULL) { + return TCL_ERROR; + } + if (chmod(translated, (unsigned) mode) != 0) { + Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), + NULL); + return TCL_ERROR; + } + Tcl_DStringFree(&buffer); + } + return TCL_OK; +} diff --git a/win/tclWinFile.c b/win/tclWinFile.c index f4d882b..507c2a1 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.14 2006/03/10 10:35:25 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.15 2006/03/19 22:47:30 vincentdarley Exp $ */ //#define _WIN32_WINNT 0x0500 @@ -1342,8 +1342,7 @@ NativeAccess( } if ((mode & W_OK) - && !(attr & FILE_ATTRIBUTE_DIRECTORY) - /* && (tclWinProcs->getFileSecurityProc == NULL) */ + && (tclWinProcs->getFileSecurityProc == NULL) && (attr & FILE_ATTRIBUTE_READONLY)) { /* * We don't have the advanced 'getFileSecurityProc', and @@ -1520,6 +1519,7 @@ NativeAccess( * we must still check the 'attr' value. */ if ((mode & W_OK) + && !(attr & FILE_ATTRIBUTE_DIRECTORY) && (attr & FILE_ATTRIBUTE_READONLY)) { Tcl_SetErrno(EACCES); return -1; @@ -2611,7 +2611,6 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) return nextCheckpoint; } - /* *--------------------------------------------------------------------------- * |