summaryrefslogtreecommitdiffstats
path: root/generic/tclPathObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclPathObj.c')
-rw-r--r--generic/tclPathObj.c294
1 files changed, 121 insertions, 173 deletions
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index eb19096..dd68004 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -33,7 +33,7 @@ static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr);
* internally.
*/
-static Tcl_ObjType tclFsPathType = {
+static const Tcl_ObjType tclFsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
@@ -237,7 +237,7 @@ TclFSNormalizeAbsolutePath(
retVal = Tcl_NewStringObj(path, dirSep - path);
Tcl_IncrRefCount(retVal);
}
- (void) Tcl_GetStringFromObj(retVal, &curLen);
+ Tcl_GetStringFromObj(retVal, &curLen);
if (curLen == 0) {
Tcl_AppendToObj(retVal, dirSep, 1);
}
@@ -249,7 +249,7 @@ TclFSNormalizeAbsolutePath(
continue;
}
if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
- Tcl_Obj *link;
+ Tcl_Obj *linkObj;
int curLen;
char *linkStr;
@@ -263,21 +263,22 @@ TclFSNormalizeAbsolutePath(
retVal = Tcl_NewStringObj(path, dirSep - path);
Tcl_IncrRefCount(retVal);
}
- (void) Tcl_GetStringFromObj(retVal, &curLen);
+ Tcl_GetStringFromObj(retVal, &curLen);
if (curLen == 0) {
Tcl_AppendToObj(retVal, dirSep, 1);
}
if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
- link = Tcl_FSLink(retVal, NULL, 0);
- if (link != NULL) {
+ linkObj = Tcl_FSLink(retVal, NULL, 0);
+ if (linkObj != NULL) {
/*
* 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) {
+ if (tclPlatform != TCL_PLATFORM_WINDOWS
+ && Tcl_FSGetPathType(linkObj)
+ == TCL_PATH_RELATIVE) {
/*
* We need to follow this link which is relative
* to retVal's directory. This means concatenating
@@ -303,8 +304,8 @@ TclFSNormalizeAbsolutePath(
*/
Tcl_SetObjLength(retVal, curLen+1);
- Tcl_AppendObjToObj(retVal, link);
- TclDecrRefCount(link);
+ Tcl_AppendObjToObj(retVal, linkObj);
+ TclDecrRefCount(linkObj);
linkStr = Tcl_GetStringFromObj(retVal, &curLen);
} else {
/*
@@ -312,7 +313,7 @@ TclFSNormalizeAbsolutePath(
*/
TclDecrRefCount(retVal);
- retVal = link;
+ retVal = linkObj;
linkStr = Tcl_GetStringFromObj(retVal, &curLen);
/*
@@ -334,8 +335,8 @@ TclFSNormalizeAbsolutePath(
}
/*
- * Either way, we now remove the last path element.
- * (but not the first character of the path)
+ * Either way, we now remove the last path element (but
+ * not the first character of the path).
*/
while (--curLen >= 0) {
@@ -396,7 +397,7 @@ TclFSNormalizeAbsolutePath(
}
/*
- * Ensure a windows drive like C:/ has a trailing separator
+ * Ensure a windows drive like C:/ has a trailing separator.
*/
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
@@ -494,7 +495,7 @@ Tcl_FSGetPathType(
Tcl_PathType
TclFSGetPathType(
Tcl_Obj *pathPtr,
- Tcl_Filesystem **filesystemPtrPtr,
+ const Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr)
{
FsPath *fsPathPtr;
@@ -831,7 +832,7 @@ Tcl_FSJoinPath(
{
Tcl_Obj *res;
int i;
- Tcl_Filesystem *fsPtr = NULL;
+ const Tcl_Filesystem *fsPtr = NULL;
if (elements < 0) {
if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
@@ -877,17 +878,18 @@ Tcl_FSJoinPath(
* could expand that in the future.
*/
- if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
- && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
- Tcl_Obj *tail;
+ if ((i == (elements-2)) && (i == 0)
+ && (elt->typePtr == &tclFsPathType)
+ && !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) {
+ Tcl_Obj *tailObj;
- Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
- type = TclGetPathType(tail, NULL, NULL, NULL);
+ Tcl_ListObjIndex(NULL, listObj, i+1, &tailObj);
+ type = TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
const char *str;
int len;
- str = Tcl_GetStringFromObj(tail, &len);
+ str = Tcl_GetStringFromObj(tailObj, &len);
if (len == 0) {
/*
* This happens if we try to handle the root volume '/'.
@@ -935,16 +937,16 @@ Tcl_FSJoinPath(
if (res != NULL) {
TclDecrRefCount(res);
}
- return tail;
+ return tailObj;
} else {
- const char *str = TclGetString(tail);
+ const char *str = TclGetString(tailObj);
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
if (strchr(str, '\\') == NULL) {
if (res != NULL) {
TclDecrRefCount(res);
}
- return tail;
+ return tailObj;
}
}
}
@@ -1021,8 +1023,8 @@ Tcl_FSJoinPath(
}
/*
- * This element is just what we want to return already - no
- * further manipulation is requred.
+ * This element is just what we want to return already; no further
+ * manipulation is requred.
*/
return elt;
@@ -1068,7 +1070,7 @@ Tcl_FSJoinPath(
int needsSep = 0;
if (fsPtr->filesystemSeparatorProc != NULL) {
- Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
+ Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(res);
if (sep != NULL) {
separator = TclGetString(sep)[0];
@@ -1295,7 +1297,7 @@ TclNewFSPathObj(
tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
pathPtr = Tcl_NewObj();
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
/*
* Set up the path.
@@ -1318,41 +1320,41 @@ TclNewFSPathObj(
/*
* Look for path components made up of only "."
- * This is overly conservative analysis to keep simple. It may
- * mark some things as needing more aggressive normalization
- * that don't actually need it. No harm done.
+ * This is overly conservative analysis to keep simple. It may mark some
+ * things as needing more aggressive normalization that don't actually
+ * need it. No harm done.
*/
for (p = addStrRep; len > 0; p++, len--) {
- switch (state) {
- case 0: /* So far only "." since last dirsep or start */
- switch (*p) {
- case '.':
- count++;
- break;
- case '/':
- case '\\':
- case ':':
- if (count) {
- PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
- len = 0;
- }
- break;
- default:
- count = 0;
- state = 1;
- }
- case 1: /* Scanning for next dirsep */
- switch (*p) {
- case '/':
- case '\\':
- case ':':
- state = 0;
- break;
- }
- }
+ switch (state) {
+ case 0: /* So far only "." since last dirsep or start */
+ switch (*p) {
+ case '.':
+ count++;
+ break;
+ case '/':
+ case '\\':
+ case ':':
+ if (count) {
+ PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
+ len = 0;
+ }
+ break;
+ default:
+ count = 0;
+ state = 1;
+ }
+ case 1: /* Scanning for next dirsep */
+ switch (*p) {
+ case '/':
+ case '\\':
+ case ':':
+ state = 0;
+ break;
+ }
+ }
}
if (len == 0 && count) {
- PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
+ PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
}
return pathPtr;
@@ -1414,77 +1416,13 @@ TclFSMakePathRelative(
{
int cwdLen, len;
const char *tempStr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
if (PATHFLAGS(pathPtr) != 0
&& fsPathPtr->cwdPtr == cwdPtr) {
- pathPtr = fsPathPtr->normPathPtr;
-
- /* TODO: Determine how much, if any, of this forcing
- * the relative path tail into the "path" Tcl_ObjType
- * with a recorded cwdPtr context has any actual value.
- *
- * Nothing is getting cached. Not normPathPtr, not nativePathPtr,
- * nor fsRecPtr, so storing the cwdPtr context against which such
- * cached values might later be validated appears to be of no
- * value. Take that away, and all this code is just a mildly
- * optimized equivalent of a call to SetFsPathFromAny(). That
- * optimization may have some value, *if* these value in fact
- * get used as "path" values before used as something else.
- * If not, though, whatever cost we pay below to convert to
- * one of the "path" intreps is just a waste, it seems. The
- * usual convention in the core is to delay ObjType conversion
- * until it is needed and demanded, and I don't see why this
- * section of code should be an exception to that. Leaving it
- * in place for the rest of the 8.5.* releases just for sake
- * of stability.
- */
-
- /*
- * Free old representation.
- */
-
- if (pathPtr->typePtr != NULL) {
- if (pathPtr->bytes == NULL) {
- if (pathPtr->typePtr->updateStringProc == NULL) {
- if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't find object"
- "string representation", NULL);
- }
- return NULL;
- }
- pathPtr->typePtr->updateStringProc(pathPtr);
- }
- TclFreeIntRep(pathPtr);
- }
-
- /*
- * Now pathPtr is a string object.
- */
-
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
-
- /*
- * Circular reference, by design.
- */
-
- fsPathPtr->translatedPathPtr = pathPtr;
- fsPathPtr->normPathPtr = NULL;
- fsPathPtr->cwdPtr = cwdPtr;
- Tcl_IncrRefCount(cwdPtr);
- fsPathPtr->nativePathPtr = NULL;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
- SETPATHOBJ(pathPtr, fsPathPtr);
- PATHFLAGS(pathPtr) = 0;
- pathPtr->typePtr = &tclFsPathType;
-
- return pathPtr;
+ return fsPathPtr->normPathPtr;
}
}
@@ -1566,6 +1504,8 @@ TclFSMakePathFromNormalized(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "can't find object"
"string representation", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
+ NULL);
}
return TCL_ERROR;
}
@@ -1574,7 +1514,7 @@ TclFSMakePathFromNormalized(
TclFreeIntRep(pathPtr);
}
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
/*
* It's a pure normalized absolute path.
@@ -1626,7 +1566,7 @@ TclFSMakePathFromNormalized(
Tcl_Obj *
Tcl_FSNewNativePath(
- Tcl_Filesystem *fromFilesystem,
+ const Tcl_Filesystem *fromFilesystem,
ClientData clientData)
{
Tcl_Obj *pathPtr;
@@ -1656,7 +1596,7 @@ Tcl_FSNewNativePath(
TclFreeIntRep(pathPtr);
}
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
fsPathPtr->translatedPathPtr = NULL;
@@ -1725,7 +1665,7 @@ Tcl_FSGetTranslatedPath(
}
retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
- &(srcFsPathPtr->normPathPtr));
+ &srcFsPathPtr->normPathPtr);
srcFsPathPtr->translatedPathPtr = retObj;
Tcl_IncrRefCount(retObj);
Tcl_DecrRefCount(translatedCwdPtr);
@@ -1781,7 +1721,7 @@ Tcl_FSGetTranslatedStringPath(
if (transPtr != NULL) {
int len;
const char *orig = Tcl_GetStringFromObj(transPtr, &len);
- char *result = (char *) ckalloc((unsigned) len+1);
+ char *result = ckalloc(len+1);
memcpy(result, orig, (size_t) len+1);
TclDecrRefCount(transPtr);
@@ -1857,25 +1797,25 @@ Tcl_FSGetNormalizedPath(
if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
/*
- * If the "tail" part has components (like /../) that cause
- * the combined path to need more complete normalizing,
- * call on the more powerful routine to accomplish that so
- * we avoid [Bug 2385549] ...
+ * If the "tail" part has components (like /../) that cause the
+ * combined path to need more complete normalizing, call on the
+ * more powerful routine to accomplish that so we avoid [Bug
+ * 2385549] ...
*/
Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL);
+
Tcl_DecrRefCount(copy);
copy = newCopy;
} else {
/*
- * ... but in most cases where we join a trouble free tail
- * to a normalized head, we can more efficiently normalize the
- * combined path by passing over only the unnormalized tail
- * portion. When this is sufficient, prior developers claim
- * this should be much faster. We use 'cwdLen-1' so that we are
- * already pointing at the dir-separator that we know about.
- * The normalization code will actually start off directly
- * after that separator.
+ * ... but in most cases where we join a trouble free tail to a
+ * normalized head, we can more efficiently normalize the combined
+ * path by passing over only the unnormalized tail portion. When
+ * this is sufficient, prior developers claim this should be much
+ * faster. We use 'cwdLen-1' so that we are already pointing at
+ * the dir-separator that we know about. The normalization code
+ * will actually start off directly after that separator.
*/
TclFSNormalizeToUniquePath(interp, copy, cwdLen-1,
@@ -1889,11 +1829,11 @@ Tcl_FSGetNormalizedPath(
/*
* NOTE: here we are (dangerously?) assuming that origDir points
- * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType . The
+ * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The
* pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
- * above that set the pathType value should have established
- * that, but it's far less clear on what basis we know there's
- * been no shimmering since then.
+ * above that set the pathType value should have established that,
+ * but it's far less clear on what basis we know there's been no
+ * shimmering since then.
*/
FsPath *origDirFsPathPtr = PATHOBJ(origDir);
@@ -1925,8 +1865,8 @@ Tcl_FSGetNormalizedPath(
if (clientData != NULL) {
/*
* This may be unnecessary. It appears that the
- * TclFSNormalizeToUniquePath call above should have already
- * set this up. Not changing out of fear of the unknown.
+ * TclFSNormalizeToUniquePath call above should have already set
+ * this up. Not changing out of fear of the unknown.
*/
fsPathPtr->nativePathPtr = clientData;
@@ -1996,11 +1936,11 @@ Tcl_FSGetNormalizedPath(
if (path[0] == '\0') {
/*
- * Special handling for the empty string value. This one is
- * very weird with [file normalize {}] => {}. (The reasoning
- * supporting this is unknown to DGP, but he fears changing it.)
- * Attempt here to keep the expectations of other parts of
- * Tcl_Filesystem code about state of the FsPath fields satisfied.
+ * Special handling for the empty string value. This one is very
+ * weird with [file normalize {}] => {}. (The reasoning supporting
+ * this is unknown to DGP, but he fears changing it.) Attempt here
+ * to keep the expectations of other parts of Tcl_Filesystem code
+ * about state of the FsPath fields satisfied.
*
* In particular, capture the cwd value and save so it can be
* stored in the cwdPtr field below.
@@ -2059,7 +1999,7 @@ Tcl_FSGetNormalizedPath(
(fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
if (0 && (clientData != NULL)) {
fsPathPtr->nativePathPtr =
- (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData);
+ fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc(clientData);
}
/*
@@ -2068,8 +2008,12 @@ Tcl_FSGetNormalizedPath(
*/
if (pureNormalized) {
- if (!strcmp(TclGetString(fsPathPtr->normPathPtr),
- TclGetString(pathPtr))) {
+ int normPathLen, pathLen;
+ const char *normPath;
+
+ path = TclGetStringFromObj(pathPtr, &pathLen);
+ normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen);
+ if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) {
/*
* The path was already normalized. Get rid of the duplicate.
*/
@@ -2124,7 +2068,7 @@ Tcl_FSGetNormalizedPath(
ClientData
Tcl_FSGetInternalRep(
Tcl_Obj *pathPtr,
- Tcl_Filesystem *fsPtr)
+ const Tcl_Filesystem *fsPtr)
{
FsPath *srcFsPathPtr;
@@ -2197,7 +2141,7 @@ Tcl_FSGetInternalRep(
return NULL;
}
- nativePathPtr = (*proc)(pathPtr);
+ nativePathPtr = proc(pathPtr);
srcFsPathPtr = PATHOBJ(pathPtr);
srcFsPathPtr->nativePathPtr = nativePathPtr;
}
@@ -2226,7 +2170,7 @@ Tcl_FSGetInternalRep(
int
TclFSEnsureEpochOk(
Tcl_Obj *pathPtr,
- Tcl_Filesystem **fsPtrPtr)
+ const Tcl_Filesystem **fsPtrPtr)
{
FsPath *srcFsPathPtr;
@@ -2330,7 +2274,7 @@ Tcl_FSEqualPaths(
Tcl_Obj *firstPtr,
Tcl_Obj *secondPtr)
{
- char *firstStr, *secondStr;
+ const char *firstStr, *secondStr;
int firstLen, secondLen, tempErrno;
if (firstPtr == secondPtr) {
@@ -2340,9 +2284,9 @@ Tcl_FSEqualPaths(
if (firstPtr == NULL || secondPtr == NULL) {
return 0;
}
- firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
- secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
- if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
+ firstStr = TclGetStringFromObj(firstPtr, &firstLen);
+ secondStr = TclGetStringFromObj(secondPtr, &secondLen);
+ if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) {
return 1;
}
@@ -2360,9 +2304,9 @@ Tcl_FSEqualPaths(
return 0;
}
- firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
- secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
- return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0);
+ firstStr = TclGetStringFromObj(firstPtr, &firstLen);
+ secondStr = TclGetStringFromObj(secondPtr, &secondLen);
+ return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen));
}
/*
@@ -2397,7 +2341,7 @@ SetFsPathFromAny(
#if defined(__CYGWIN__) && defined(__WIN32__)
int copied = 0;
#endif
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -2460,6 +2404,8 @@ SetFsPathFromAny(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't find HOME environment "
"variable to expand path", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
+ "HOMELESS", NULL);
}
return TCL_ERROR;
}
@@ -2477,6 +2423,8 @@ SetFsPathFromAny(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "user \"", name+1,
"\" doesn't exist", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
+ NULL);
}
Tcl_DStringFree(&temp);
if (split != len) {
@@ -2569,7 +2517,7 @@ SetFsPathFromAny(
* slashes on Windows, and will not contain any ~user sequences.
*/
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
fsPathPtr->translatedPathPtr = transPtr;
if (transPtr != pathPtr) {
@@ -2623,7 +2571,7 @@ FreeFsPathInternalRep(
fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc;
if (freeProc != NULL) {
- (*freeProc)(fsPathPtr->nativePathPtr);
+ freeProc(fsPathPtr->nativePathPtr);
fsPathPtr->nativePathPtr = NULL;
}
}
@@ -2634,11 +2582,11 @@ FreeFsPathInternalRep(
* It has been unregistered already.
*/
- ckfree((char *) fsPathPtr->fsRecPtr);
+ ckfree(fsPathPtr->fsRecPtr);
}
}
- ckfree((char *) fsPathPtr);
+ ckfree(fsPathPtr);
pathPtr->typePtr = NULL;
}
@@ -2648,7 +2596,7 @@ DupFsPathInternalRep(
Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */
{
FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
- FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath));
SETPATHOBJ(copyPtr, copyFsPathPtr);
@@ -2686,7 +2634,7 @@ DupFsPathInternalRep(
if (dupProc != NULL) {
copyFsPathPtr->nativePathPtr =
- (*dupProc)(srcFsPathPtr->nativePathPtr);
+ dupProc(srcFsPathPtr->nativePathPtr);
} else {
copyFsPathPtr->nativePathPtr = NULL;
}
generated by cgit v0.12 at 2024-11-19 19:49:54 (GMT)