summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley@noemail.net>2004-01-29 13:01:24 (GMT)
committervincentdarley <vincentdarley@noemail.net>2004-01-29 13:01:24 (GMT)
commit163b85e235d97c776e99927cada0191c18620780 (patch)
treef4f8db8b34eb2eaac06440482a42e0188e2300e6
parentdada5dbf2603014507e935e6a39f3a68dcb09d39 (diff)
downloadtcl-163b85e235d97c776e99927cada0191c18620780.zip
tcl-163b85e235d97c776e99927cada0191c18620780.tar.gz
tcl-163b85e235d97c776e99927cada0191c18620780.tar.bz2
fix to file normalization with links
FossilOrigin-Name: ea7a46acae8dd0a2b655f8fd8ef203bcce9c03ac
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclPathObj.c54
2 files changed, 47 insertions, 11 deletions
diff --git a/ChangeLog b/ChangeLog
index 7d3e573..df6d4e1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2004-01-29 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclPathObj.c: fix to [Bug 883143] in file normalization
+
+2004-01-29 Vince Darley <vincentdarley@users.sourceforge.net>
+
* doc/file.n:
* generic/tclFCmd.c
* generic/tclTest.c
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 5be3447..4391d46 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -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: tclPathObj.c,v 1.22 2004/01/29 10:28:20 vincentdarley Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.23 2004/01/29 13:01:24 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -246,16 +246,48 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
link = Tcl_FSLink(retVal, NULL, 0);
if (link != NULL) {
- /* Got a link */
- Tcl_DecrRefCount(retVal);
- retVal = link;
- linkStr = Tcl_GetStringFromObj(retVal, &curLen);
- /* Convert to forward-slashes on windows */
- if (tclPlatform == TCL_PLATFORM_WINDOWS) {
- int i;
- for (i = 0; i < curLen; i++) {
- if (linkStr[i] == '\\') {
- linkStr[i] = '/';
+ /*
+ * Got a link. Need to check if the link
+ * is relative or absolute, for those platforms
+ * where relative links exist.
+ */
+ if ((tclPlatform != TCL_PLATFORM_WINDOWS)
+ && (Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE)) {
+ /*
+ * We need to follow this link which is
+ * relative to retVal's directory. This
+ * means concatenating the link onto
+ * the directory of the path so far.
+ */
+ CONST char *path = Tcl_GetStringFromObj(retVal,
+ &curLen);
+ while (--curLen >= 0) {
+ if (IsSeparatorOrNull(path[curLen])) {
+ break;
+ }
+ }
+ if (Tcl_IsShared(retVal)) {
+ Tcl_DecrRefCount(retVal);
+ retVal = Tcl_DuplicateObj(retVal);
+ Tcl_IncrRefCount(retVal);
+ }
+ /* We want the trailing slash */
+ Tcl_SetObjLength(retVal, curLen+1);
+ Tcl_AppendObjToObj(retVal, link);
+ Tcl_DecrRefCount(link);
+ linkStr = Tcl_GetStringFromObj(retVal, &curLen);
+ } else {
+ /* Absolute link */
+ Tcl_DecrRefCount(retVal);
+ retVal = link;
+ linkStr = Tcl_GetStringFromObj(retVal, &curLen);
+ /* Convert to forward-slashes on windows */
+ if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+ int i;
+ for (i = 0; i < curLen; i++) {
+ if (linkStr[i] == '\\') {
+ linkStr[i] = '/';
+ }
}
}
}