summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCmdAH.c25
-rw-r--r--tests/fCmd.test10
3 files changed, 32 insertions, 9 deletions
diff --git a/ChangeLog b/ChangeLog
index cdbef4a..283eb78 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-11-10 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclCmdAH.c:
+ * tests/fCmd.test: fix to misleading error message in 'file link'
+ [Bug 836208]
+
2003-11-07 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclIOUtil.c: fix to compiler warning/error with
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index ac2043c..e049520 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.35 2003/10/22 08:29:13 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.36 2003/11/10 17:57:21 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -1062,7 +1062,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
if (contents == NULL) {
/*
- * We handle two common error cases specially, and
+ * We handle three common error cases specially, and
* for all other errors, we use the standard posix
* error message.
*/
@@ -1071,12 +1071,21 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
Tcl_GetString(objv[index]),
"\": that path already exists", (char *) NULL);
} else if (errno == ENOENT) {
- Tcl_AppendResult(interp, "could not create new link \"",
- Tcl_GetString(objv[index]),
- "\" since target \"",
- Tcl_GetString(objv[index+1]),
- "\" doesn't exist",
- (char *) NULL);
+ if (Tcl_FSAccess(objv[index+1], F_OK) == 0) {
+ Tcl_AppendResult(interp,
+ "could not create new link \"",
+ Tcl_GetString(objv[index]),
+ "\": no such file or directory",
+ (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp,
+ "could not create new link \"",
+ Tcl_GetString(objv[index]),
+ "\" since target \"",
+ Tcl_GetString(objv[index+1]),
+ "\" doesn't exist",
+ (char *) NULL);
+ }
} else {
Tcl_AppendResult(interp, "could not create new link \"",
Tcl_GetString(objv[index]), "\" pointing to \"",
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 12ef859..38bfcd4 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.31 2003/10/07 16:00:33 dgp Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.32 2003/11/10 17:57:21 vincentdarley Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -2308,6 +2308,14 @@ test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} {
set res
} {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}}
+test fCmd-28.10.1 {file link: linking to nonexistent path} {linkDirectory} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ set res [list [catch {file link doesnt/abc.link abc.dir} msg] $msg]
+ cd [workingDirectory]
+ set res
+} {1 {could not create new link "doesnt/abc.link": no such file or directory}}
+
test fCmd-28.11 {file link: success with directory} {linkDirectory} {
cd [temporaryDirectory]
file delete -force abc.link