summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorhobbs <hobbs>2002-08-08 08:56:18 (GMT)
committerhobbs <hobbs>2002-08-08 08:56:18 (GMT)
commit1d73c07b16f3304b87070edf4a7aee24a263402f (patch)
treeaeaa59f60f701e1b111d28a3ca390205142aa573 /tests
parent1e8d54aee72071673f69d387e8130f02b46934a7 (diff)
downloadtcl-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.test25
-rw-r--r--tests/unixFCmd.test5
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"