summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog3
-rw-r--r--generic/tclFCmd.c6
-rw-r--r--tests/fCmd.test39
-rw-r--r--tests/unixFCmd.test12
4 files changed, 51 insertions, 9 deletions
diff --git a/ChangeLog b/ChangeLog
index e26a345..e2e642a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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"