* 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)

4 files changed, 81 insertions, 17 deletions

diff --git a/ChangeLog b/ChangeLog
index 137929c..e26a345 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2002-08-08  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* 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)
+
+	* tests/README: slight wording improvements
+
 2002-08-07  Miguel Sofer  <msofer@users.sourceforge.net>
 
 	* docs/BoolObj.3: added description of valid string reps for a
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index e027977..743fe14 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.18 2002/07/18 16:17:48 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.19 2002/08/08 08:56:21 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -448,6 +448,8 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 {
     int result;
     Tcl_Obj *errfile, *errorBuffer;
+    /* If source is a link, then this is the real file/directory */
+    Tcl_Obj *actualSource = NULL;
     Tcl_StatBuf sourceStatBuf, targetStatBuf;
 
     if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
@@ -549,8 +551,53 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	 */
     }
 
+    actualSource = source;
+    Tcl_IncrRefCount(actualSource);
+#ifdef S_ISLNK
+    /* 
+     * To add a flag to make 'copy' copy links instead of files, we could
+     * add a condition to ignore this 'if' here.
+     */
+    if (copyFlag && S_ISLNK(sourceStatBuf.st_mode)) {
+	/* 
+	 * We want to copy files not links.  Therefore we must follow the
+	 * link.  There are two purposes to this 'stat' call here.  First
+	 * we want to know if the linked-file/dir actually exists, and
+	 * second, in the block of code which follows, some 20 lines
+	 * down, we want to check if the thing is a file or directory.
+	 */
+	if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
+	    /* Actual file doesn't exist */
+	    Tcl_AppendResult(interp, 
+		    "error copying \"", Tcl_GetString(source), 
+		    "\": the target of this link doesn't exist",
+		    (char *) NULL);
+	    goto done;
+	} else {
+	    int counter = 0;
+	    while (1) {
+		Tcl_Obj *path = Tcl_FSLink(actualSource,NULL,0);
+		if (path == NULL) {
+		    break;
+		}
+		Tcl_DecrRefCount(actualSource);
+		actualSource = path;
+		counter++;
+		/* Arbitrary limit of 20 links to follow */
+		if (counter > 20) {
+		    /* Too many links */
+		    Tcl_SetErrno(EMLINK);
+		    errfile = source;
+		    goto done;
+		}
+	    }
+	    /* Now 'actualSource' is the correct file */
+	}
+    }
+#endif
+
     if (S_ISDIR(sourceStatBuf.st_mode)) {
-	result = Tcl_FSCopyDirectory(source, target, &errorBuffer);
+	result = Tcl_FSCopyDirectory(actualSource, target, &errorBuffer);
 	if (result != TCL_OK) {
 	    if (errno == EXDEV) {
 		/* 
@@ -598,7 +645,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	    }
 	}
     } else {
-	result = Tcl_FSCopyFile(source, target);
+	result = Tcl_FSCopyFile(actualSource, target);
 	if ((result != TCL_OK) && (errno == EXDEV)) {
 	    result = TclCrossFilesystemCopy(interp, source, target);
 	}
@@ -652,6 +699,9 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
     if (errorBuffer != NULL) {
         Tcl_DecrRefCount(errorBuffer);
     }
+    if (actualSource != NULL) {
+	Tcl_DecrRefCount(actualSource);
+    }
     return result;
 }
 
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"