summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclIOUtil.c307
1 files changed, 85 insertions, 222 deletions
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 0f8999f..f91a2b6 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.15 2004/02/18 01:34:04 hobbs Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.16 2004/02/18 01:59:09 hobbs Exp $
*/
#include "tclInt.h"
@@ -96,11 +96,6 @@ Tcl_FSPathInFilesystemProc NativePathInFilesystem;
static Tcl_Obj* TclFSNormalizeAbsolutePath
_ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr,
ClientData *clientDataPtr));
-
-static int FindSplitPos _ANSI_ARGS_((CONST char *path,
- int separator));
-static int IsSeparatorOrNull _ANSI_ARGS_((int ch));
-
/*
* Prototypes for procedures defined later in this file.
*/
@@ -1308,9 +1303,6 @@ Tcl_FSData(fsPtr)
*
* The behaviour of this function if passed a non-absolute path
* is NOT defined.
- *
- * pathPtr may have a refCount of zero, or may be a shared
- * object.
*
* Results:
* The result is returned in a Tcl_Obj with a refCount of 1,
@@ -1321,195 +1313,93 @@ Tcl_FSData(fsPtr)
* None (beyond the memory allocation for the result).
*
* Special note:
- * This code was originally based on code from Matt Newman and
- * Jean-Claude Wippler, but has since been totally rewritten by
- * Vince Darley to deal with symbolic links.
+ * This code is based on code from Matt Newman and Jean-Claude
+ * Wippler, with additions from Vince Darley and is copyright
+ * those respective authors.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj*
TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
- Tcl_Interp* interp; /* Interpreter to use */
- Tcl_Obj *pathPtr; /* Absolute path to normalize */
- ClientData *clientDataPtr; /* If non-NULL, then may be set to the
- * fs-specific clientData for this path.
- * This will happen when that extra
- * information can be calculated efficiently
- * as a side-effect of normalization. */
+ Tcl_Interp* interp; /* Interpreter to use */
+ Tcl_Obj *pathPtr; /* Absolute path to normalize */
+ ClientData *clientDataPtr;
{
- ClientData clientData = NULL;
- CONST char *dirSep, *oldDirSep;
- int first = 1; /* Set to zero once we've passed the first
- * directory separator - we can't use '..' to
- * remove the volume in a path. */
- Tcl_Obj *retVal = NULL;
- dirSep = Tcl_GetString(pathPtr);
+ int splen = 0, nplen, eltLen, i;
+ char *eltName;
+ Tcl_Obj *retVal;
+ Tcl_Obj *split;
+ Tcl_Obj *elt;
- if (tclPlatform == TCL_PLATFORM_WINDOWS) {
- if (dirSep[0] != 0 && dirSep[1] == ':' &&
- (dirSep[2] == '/' || dirSep[2] == '\\')) {
- /* Do nothing */
- } else if ((dirSep[0] == '/' || dirSep[0] == '\\')
- && (dirSep[1] == '/' || dirSep[1] == '\\')) {
- /*
- * UNC style path, where we must skip over the
- * first separator, since the first two segments
- * are actually inseparable.
- */
- dirSep += 2;
- dirSep += FindSplitPos(dirSep, '/');
- if (*dirSep != 0) {
- dirSep++;
- }
- }
- }
+ /* Split has refCount zero */
+ split = Tcl_FSSplitPath(pathPtr, &splen);
/*
- * Scan forward from one directory separator to the next,
- * checking for '..' and '.' sequences which must be handled
- * specially. In particular handling of '..' can be complicated
- * if the directory before is a link, since we will have to
- * expand the link to be able to back up one level.
+ * Modify the list of entries in place, by removing '.', and
+ * removing '..' and the entry before -- unless that entry before
+ * is the top-level entry, i.e. the name of a volume.
*/
- while (*dirSep != 0) {
- oldDirSep = dirSep;
- dirSep += 1+FindSplitPos(dirSep+1, '/');
- if (dirSep[0] == 0 || dirSep[1] == 0) {
- if (retVal != NULL) {
- Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
- }
- break;
- }
- if (dirSep[1] == '.') {
- if (retVal != NULL) {
- Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
- }
- again:
- if (IsSeparatorOrNull(dirSep[2])) {
- /* Need to skip '.' in the path */
- if (retVal == NULL) {
- CONST char *path = Tcl_GetString(pathPtr);
- retVal = Tcl_NewStringObj(path, dirSep - path);
- Tcl_IncrRefCount(retVal);
- }
- dirSep += 2;
- if (dirSep[0] != 0 && dirSep[1] == '.') {
- goto again;
- }
- continue;
- }
- if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
- Tcl_Obj *link;
- int curLen;
- char *linkStr;
- /* Have '..' so need to skip previous directory */
- if (retVal == NULL) {
- CONST char *path = Tcl_GetString(pathPtr);
- retVal = Tcl_NewStringObj(path, dirSep - path);
- Tcl_IncrRefCount(retVal);
- }
- if (!first) {
- 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] = '/';
- }
- }
- }
- } else {
- linkStr = Tcl_GetStringFromObj(retVal, &curLen);
- }
- /* Either way, we now remove the last path element */
- while (--curLen > 0) {
- if (IsSeparatorOrNull(linkStr[curLen])) {
- Tcl_SetObjLength(retVal, curLen);
- break;
- }
- }
- }
- dirSep += 3;
- if (dirSep[0] != 0 && dirSep[1] == '.') {
- goto again;
- }
- continue;
+ nplen = 0;
+ for (i = 0; i < splen; i++) {
+ Tcl_ListObjIndex(NULL, split, nplen, &elt);
+ eltName = Tcl_GetStringFromObj(elt, &eltLen);
+
+ if ((eltLen == 1) && (eltName[0] == '.')) {
+ Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
+ } else if ((eltLen == 2)
+ && (eltName[0] == '.') && (eltName[1] == '.')) {
+ if (nplen > 1) {
+ nplen--;
+ Tcl_ListObjReplace(NULL, split, nplen, 2, 0, NULL);
+ } else {
+ Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
}
- }
- first = 0;
- if (retVal != NULL) {
- Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
+ } else {
+ nplen++;
}
}
-
- /*
- * If we didn't make any changes, just use the input path
- */
- if (retVal == NULL) {
- retVal = pathPtr;
- Tcl_IncrRefCount(retVal);
+ if (nplen > 0) {
+ ClientData clientData = NULL;
- if (Tcl_IsShared(retVal)) {
- /*
- * Unfortunately, the platform-specific normalization code
- * which will be called below has no way of dealing with the
- * case where an object is shared. It is expecting to
- * modify an object in place. So, we must duplicate this
- * here to ensure an object with a single ref-count.
- *
- * If that changes in the future (e.g. the normalize proc is
- * given one object and is able to return a different one),
- * then we could remove this code.
- */
- Tcl_DecrRefCount(retVal);
- retVal = Tcl_DuplicateObj(pathPtr);
- Tcl_IncrRefCount(retVal);
- }
- }
-
- /*
- * Ensure a windows drive like C:/ has a trailing separator
- */
- if (tclPlatform == TCL_PLATFORM_WINDOWS) {
- int len;
- CONST char *path = Tcl_GetStringFromObj(retVal, &len);
- if (len == 2 && path[0] != 0 && path[1] == ':') {
- if (Tcl_IsShared(retVal)) {
- Tcl_DecrRefCount(retVal);
- retVal = Tcl_DuplicateObj(retVal);
- Tcl_IncrRefCount(retVal);
- }
- Tcl_AppendToObj(retVal, "/", 1);
+ retVal = Tcl_FSJoinPath(split, nplen);
+ /*
+ * Now we have an absolute path, with no '..', '.' sequences,
+ * but it still may not be in 'unique' form, depending on the
+ * platform. For instance, Unix is case-sensitive, so the
+ * path is ok. Windows is case-insensitive, and also has the
+ * weird 'longname/shortname' thing (e.g. C:/Program Files/ and
+ * C:/Progra~1/ are equivalent). MacOS is case-insensitive.
+ *
+ * Virtual file systems which may be registered may have
+ * other criteria for normalizing a path.
+ */
+ Tcl_IncrRefCount(retVal);
+ TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData);
+ /*
+ * Since we know it is a normalized path, we can
+ * actually convert this object into an "path" object for
+ * greater efficiency
+ */
+ TclFSMakePathFromNormalized(interp, retVal, clientData);
+ if (clientDataPtr != NULL) {
+ *clientDataPtr = clientData;
}
+ } else {
+ /* Init to an empty string */
+ retVal = Tcl_NewStringObj("",0);
+ Tcl_IncrRefCount(retVal);
}
-
- /*
- * Now we have an absolute path, with no '..', '.' sequences,
- * but it still may not be in 'unique' form, depending on the
- * platform. For instance, Unix is case-sensitive, so the
- * path is ok. Windows is case-insensitive, and also has the
- * weird 'longname/shortname' thing (e.g. C:/Program Files/ and
- * C:/Progra~1/ are equivalent). MacOS is case-insensitive.
- *
- * Virtual file systems which may be registered may have
- * other criteria for normalizing a path.
- */
- TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData);
/*
- * Since we know it is a normalized path, we can
- * actually convert this object into an FsPath for
- * greater efficiency
+ * We increment and then decrement the refCount of split to free
+ * it. We do this right at the end, in case there are
+ * optimisations in Tcl_FSJoinPath(split, nplen) above which would
+ * let it make use of split more effectively if it has a refCount
+ * of zero. Also we can't just decrement the ref count, in case
+ * 'split' was actually returned by the join call above, in a
+ * single-element optimisation when nplen == 1.
*/
- TclFSMakePathFromNormalized(interp, retVal, clientData);
- if (clientDataPtr != NULL) {
- *clientDataPtr = clientData;
- }
+ Tcl_IncrRefCount(split);
+ Tcl_DecrRefCount(split);
/* This has a refCount of 1 for the caller */
return retVal;
@@ -4589,6 +4479,9 @@ static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *objPtr));
static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
+static int FindSplitPos _ANSI_ARGS_((char *path, char *separator));
+
+
/*
* Define the 'path' object type, which Tcl uses to represent
@@ -4992,45 +4885,20 @@ Tcl_FSConvertToPathType(interp, objPtr)
}
/*
- * Helper function for normalization.
- */
-static int
-IsSeparatorOrNull(ch)
- int ch;
-{
- if (ch == 0) {
- return 1;
- }
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX: {
- return (ch == '/' ? 1 : 0);
- }
- case TCL_PLATFORM_MAC: {
- return (ch == ':' ? 1 : 0);
- }
- case TCL_PLATFORM_WINDOWS: {
- return ((ch == '/' || ch == '\\') ? 1 : 0);
- }
- }
- return 0;
-}
-
-/*
* Helper function for SetFsPathFromAny. Returns position of first
- * directory delimiter in the path. If no separator is found, then
- * returns the position of the end of the string.
+ * directory delimiter in the path.
*/
static int
FindSplitPos(path, separator)
- CONST char *path;
- int separator;
+ char *path;
+ char *separator;
{
int count = 0;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
case TCL_PLATFORM_MAC:
while (path[count] != 0) {
- if (path[count] == separator) {
+ if (path[count] == *separator) {
return count;
}
count++;
@@ -5039,7 +4907,7 @@ FindSplitPos(path, separator)
case TCL_PLATFORM_WINDOWS:
while (path[count] != 0) {
- if (path[count] == separator || path[count] == '\\') {
+ if (path[count] == *separator || path[count] == '\\') {
return count;
}
count++;
@@ -5700,14 +5568,12 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr)
* Path of form C:foo/bar, but this only makes
* sense if the cwd is also on drive C.
*/
- int cwdLen;
- CONST char *drive = Tcl_GetStringFromObj(useThisCwd,
- &cwdLen);
- char drive_cur = path[0];
- if (drive_cur >= 'a') {
- drive_cur -= ('a' - 'A');
+ CONST char *drive = Tcl_GetString(useThisCwd);
+ char drive_c = path[0];
+ if (drive_c >= 'a') {
+ drive_c -= ('a' - 'A');
}
- if (drive[0] == drive_cur) {
+ if (drive[0] == drive_c) {
absolutePath = Tcl_DuplicateObj(useThisCwd);
/* We have a refCount on the cwd */
} else {
@@ -5723,10 +5589,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr)
absolutePath = Tcl_NewStringObj(path, 2);
}
Tcl_IncrRefCount(absolutePath);
- if (drive[cwdLen-1] != '/') {
- /* Only add a trailing '/' if needed */
- Tcl_AppendToObj(absolutePath, "/", 1);
- }
+ Tcl_AppendToObj(absolutePath, "/", 1);
Tcl_AppendToObj(absolutePath, path+2, -1);
}
#endif /* __WIN32__ */
@@ -6069,7 +5932,7 @@ SetFsPathFromAny(interp, objPtr)
if (strchr(name, ':') != NULL) separator = ':';
}
- split = FindSplitPos(name, separator);
+ split = FindSplitPos(name, &separator);
if (split != len) {
/* We have multiple pieces '~user/foo/bar...' */
name[split] = '\0';
generated by cgit v0.12 at 2024-11-11 15:56:53 (GMT)