diff options
author | vincentdarley <vincentdarley@noemail.net> | 2004-01-29 13:01:24 (GMT) |
---|---|---|
committer | vincentdarley <vincentdarley@noemail.net> | 2004-01-29 13:01:24 (GMT) |
commit | 163b85e235d97c776e99927cada0191c18620780 (patch) | |
tree | f4f8db8b34eb2eaac06440482a42e0188e2300e6 | |
parent | dada5dbf2603014507e935e6a39f3a68dcb09d39 (diff) | |
download | tcl-163b85e235d97c776e99927cada0191c18620780.zip tcl-163b85e235d97c776e99927cada0191c18620780.tar.gz tcl-163b85e235d97c776e99927cada0191c18620780.tar.bz2 |
fix to file normalization with links
FossilOrigin-Name: ea7a46acae8dd0a2b655f8fd8ef203bcce9c03ac
-rw-r--r-- | ChangeLog | 4 | ||||
-rw-r--r-- | generic/tclPathObj.c | 54 |
2 files changed, 47 insertions, 11 deletions
@@ -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] = '/'; + } } } } |