diff options
-rw-r--r-- | ChangeLog | 3 | ||||
-rw-r--r-- | generic/tclFCmd.c | 6 | ||||
-rw-r--r-- | tests/fCmd.test | 39 | ||||
-rw-r--r-- | tests/unixFCmd.test | 12 |
4 files changed, 51 insertions, 9 deletions
@@ -7,6 +7,9 @@ just copying the surface link. This means that trying to copy a link that has no endpoint (danling link) is an error. [Patch #591647] (darley) + (CopyRenameOneFile): this is currently disabled by default until + further issues with such behavior (like relative links) can be + handled correctly. * tests/README: slight wording improvements diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 743fe14..50bea95 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.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: tclFCmd.c,v 1.19 2002/08/08 08:56:21 hobbs Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.20 2002/08/08 10:41:22 hobbs Exp $ */ #include "tclInt.h" @@ -553,6 +553,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) actualSource = source; Tcl_IncrRefCount(actualSource); +#if 0 #ifdef S_ISLNK /* * To add a flag to make 'copy' copy links instead of files, we could @@ -576,7 +577,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) } else { int counter = 0; while (1) { - Tcl_Obj *path = Tcl_FSLink(actualSource,NULL,0); + Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0); if (path == NULL) { break; } @@ -595,6 +596,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) } } #endif +#endif if (S_ISDIR(sourceStatBuf.st_mode)) { result = Tcl_FSCopyDirectory(actualSource, target, &errorBuffer); diff --git a/tests/fCmd.test b/tests/fCmd.test index cca7d0c..11d1289 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.22 2002/08/08 08:56:21 hobbs Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.23 2002/08/08 10:41:22 hobbs Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -1885,7 +1885,7 @@ test fCmd-21.6 {copy: mixed dirs and files into directory} \ set result } {1} -test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} { +test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot dontCopyLinks} { file mkdir tfad1 file link -symbolic tfalink tfad1 file delete tfad1 @@ -1893,8 +1893,17 @@ test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} { file delete -force tfalink tfalink2 set result } {1 {error copying "tfalink": the target of this link doesn't exist}} +test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} { + file mkdir tfad1 + file link -symbolic tfalink tfad1 + file delete tfad1 + file copy tfalink tfalink2 + set result [string match [file type tfalink2] link] + file delete tfalink tfalink2 + set result +} {1} -test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} { +test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unixOnly notRoot dontCopyLinks} { file mkdir tfad1 file link -symbolic tfalink tfad1 file copy tfalink tfalink2 @@ -1905,6 +1914,17 @@ test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} { file delete -force tfad1 tfalink tfalink2 set result } {1} +test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unixOnly notRoot} { + file mkdir tfad1 + file link -symbolic tfalink tfad1 + file copy tfalink tfalink2 + set r1 [file type tfalink]; # link + set r2 [file type tfalink2]; # link + set r3 [file isdir tfad1]; # 1 + set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}] + file delete -force tfad1 tfalink tfalink2 + set result +} {1} test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} { file mkdir tfad1 @@ -1943,7 +1963,7 @@ test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \ file delete -force tfa tfad set result } {1} - + # # Coverage testing for TclpRenameFile # @@ -2294,7 +2314,7 @@ test fCmd-28.14 {file link: deletes link not dir} {linkDirectory} { set res } {0 1} -test fCmd-28.15 {file link: copies link not dir} {linkDirectory} { +test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} { cd [temporaryDirectory] file delete -force abc.link file link abc.link abc.dir @@ -2305,6 +2325,15 @@ test fCmd-28.15 {file link: copies link not dir} {linkDirectory} { cd [workingDirectory] set res } {directory abc.dir} +test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} { + cd [temporaryDirectory] + file delete -force abc.link + file link abc.link abc.dir + file copy abc.link abc2.link + set res [list [file type abc2.link] [file tail [file link abc2.link]]] + cd [workingDirectory] + set res +} {link abc.dir} cd [temporaryDirectory] file delete -force abc.link diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 408fe1e..c274322 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -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: unixFCmd.test,v 1.15 2002/08/08 08:56:21 hobbs Exp $ +# RCS: @(#) $Id: unixFCmd.test,v 1.16 2002/08/08 10:41:22 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -127,7 +127,7 @@ test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \ close [open tf2 a] file copy -force tf1 tf2 } {} -test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} { +test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} {unixOnly notRoot dontCopyLinks} { # copying links should end up with real files cleanup close [open tf1 a] @@ -135,6 +135,14 @@ test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} { file copy tf2 tf3 file type tf3 } {file} +test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} { + # copying links should end up with the links copied + cleanup + close [open tf1 a] + file link -symbolic tf2 tf1 + file copy tf2 tf3 + file type tf3 +} {link} test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} { cleanup set null "/dev/null" |