diff options
author | hobbs <hobbs> | 2002-08-08 08:56:18 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2002-08-08 08:56:18 (GMT) |
commit | 1d73c07b16f3304b87070edf4a7aee24a263402f (patch) | |
tree | aeaa59f60f701e1b111d28a3ca390205142aa573 /tests | |
parent | 1e8d54aee72071673f69d387e8130f02b46934a7 (diff) | |
download | tcl-1d73c07b16f3304b87070edf4a7aee24a263402f.zip tcl-1d73c07b16f3304b87070edf4a7aee24a263402f.tar.gz tcl-1d73c07b16f3304b87070edf4a7aee24a263402f.tar.bz2 |
* tests/fCmd.test:
* tests/unixFCmd.test: updated tests for new link copy behavior.
* generic/tclFCmd.c (CopyRenameOneFile): changed the behavior to
follow links to endpoints and copy that file/directory instead of
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)
Diffstat (limited to 'tests')
-rw-r--r-- | tests/fCmd.test | 25 | ||||
-rw-r--r-- | tests/unixFCmd.test | 5 |
2 files changed, 16 insertions, 14 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test index ee9e7a0..cca7d0c 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.21 2002/07/18 16:39:50 vincentdarley Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.22 2002/08/08 08:56:21 hobbs Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -1889,21 +1889,20 @@ test fCmd-21.7 {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 [list [catch {file copy tfalink tfalink2} msg] $msg] + file delete -force tfalink tfalink2 set result -} {1} +} {1 {error copying "tfalink": the target of this link doesn't exist}} test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} { file mkdir tfad1 file link -symbolic tfalink tfad1 file copy tfalink tfalink2 - set r1 [file type tfalink] - set r2 [file type tfalink2] - set r3 [file isdir tfad1] - set result [expr {("$r1" == "link" ) && ("$r2" == "link" ) && $r3}] - file delete tfad1 tfalink tfalink2 + set r1 [file type tfalink]; # link + set r2 [file type tfalink2]; # directory + set r3 [file isdir tfad1]; # 1 + set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}] + file delete -force tfad1 tfalink tfalink2 set result } {1} @@ -2300,10 +2299,12 @@ test fCmd-28.15 {file link: copies link not dir} {linkDirectory} { 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]]] + # abc2.linkdir was a copy of a link to a dir, so it should end up as + # a directory, not a link (links trace to endpoint). + set res [list [file type abc2.link] [file tail [file link abc.link]]] cd [workingDirectory] set res -} {link abc.dir} +} {directory abc.dir} cd [temporaryDirectory] file delete -force abc.link diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 23e8752..408fe1e 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.14 2002/07/10 13:08:20 dkf Exp $ +# RCS: @(#) $Id: unixFCmd.test,v 1.15 2002/08/08 08:56:21 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -128,12 +128,13 @@ test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \ file copy -force tf1 tf2 } {} test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} { + # copying links should end up with real files cleanup close [open tf1 a] file link -symbolic tf2 tf1 file copy tf2 tf3 file type tf3 -} {link} +} {file} test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} { cleanup set null "/dev/null" |