diff options
Diffstat (limited to 'generic/tclIOUtil.c')
| -rw-r--r-- | generic/tclIOUtil.c | 145 |
1 files changed, 62 insertions, 83 deletions
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index d5fa64c..2406215 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.16 2001/08/23 18:20:50 hobbs Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.17 2001/08/30 08:53:14 vincentdarley Exp $ */ #include "tclInt.h" @@ -71,29 +71,11 @@ extern CONST TclFileAttrProcs tclpFileAttrProcs[]; /* * The following functions are obsolete string based APIs, and should - * be removed in a future release. + * be removed in a future release (Tcl 9 would be a good time). */ /* Obsolete */ int -TclStat(path, buf) - CONST char *path; /* Path of file to stat (in current CP). */ - struct stat *buf; /* Filled with results of stat call. */ -{ - return Tcl_Stat(path,buf); -} - -/* Obsolete */ -int -TclAccess(path, mode) - CONST char *path; /* Path of file to access (in current CP). */ - int mode; /* Permission setting. */ -{ - return Tcl_Access(path, mode); -} - -/* Obsolete */ -int Tcl_Stat(path, buf) CONST char *path; /* Path of file to stat (in current CP). */ struct stat *buf; /* Filled with results of stat call. */ @@ -187,17 +169,6 @@ Tcl_EvalFile(interp, fileName) return ret; } -/* Obsolete */ -int -TclpListVolumes( - Tcl_Interp *interp) /* Interpreter for returning volume list. */ -{ - Tcl_Obj *resultPtr = TclpObjListVolumes(); - Tcl_SetObjResult(interp, resultPtr); - Tcl_DecrRefCount(resultPtr); - return TCL_OK; -} - /* * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The @@ -207,6 +178,9 @@ TclpListVolumes( * from stubs/tclInt. The only known users of these APIs are prowrap * and mktclapp. New code/extensions should not use them, since they * do not provide as full support as the full filesystem API. + * + * As soon as prowrap and mktclapp are updated to use the full + * filesystem support, I suggest all these hooks are removed. */ #define USE_OBSOLETE_FS_HOOKS @@ -299,8 +273,6 @@ static Tcl_FSCreateInternalRepProc NativeCreateNativeRep; static Tcl_FSFileAttrStringsProc NativeFileAttrStrings; static Tcl_FSFileAttrsGetProc NativeFileAttrsGet; static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; -static Tcl_FSLoadFileProc NativeLoadFile; -static Tcl_FSOpenFileChannelProc NativeOpenFileChannel; static Tcl_FSUtimeProc NativeUtime; /* @@ -345,7 +317,7 @@ static Tcl_Filesystem nativeFilesystem = { &NativeFilesystemSeparator, &TclpObjStat, &TclpObjAccess, - &NativeOpenFileChannel, + &TclpOpenFileChannel, &TclpMatchInDirectory, &NativeUtime, #ifndef S_IFLNK @@ -364,7 +336,7 @@ static Tcl_Filesystem nativeFilesystem = { &TclpObjCopyFile, &TclpObjRenameFile, &TclpObjCopyDirectory, - &NativeLoadFile, + &TclpLoadFile, &TclpUnloadFile, &TclpObjGetCwd, &TclpObjChdir @@ -1602,19 +1574,33 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) if (proc != NULL) { int cwdLen; Tcl_Obj *cwdDir; + char *cwdStr; +#ifdef MAC_TCL + char sep = ':'; +#else + char sep = '/'; +#endif Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL); /* * We know the cwd is a normalised object which does - * not end in a directory delimiter. + * not end in a directory delimiter, unless the cwd + * is the name of a volume, in which case it will + * end in a delimiter! We handle this situation here. + * A better test than the '!= sep' might be to simply + * check if 'cwd' is a root volume. + * + * Note that if we get this wrong, we will strip off + * either too much or too little below, leading to + * wrong answers returned by glob. */ cwdDir = Tcl_DuplicateObj(cwd); -#ifdef MAC_TCL - Tcl_AppendToObj(cwdDir, ":", 1); -#else - Tcl_AppendToObj(cwdDir, "/", 1); -#endif - Tcl_GetStringFromObj(cwdDir, &cwdLen); Tcl_IncrRefCount(cwdDir); + cwdStr = Tcl_GetStringFromObj(cwdDir, &cwdLen); + if (cwdStr[cwdLen-1] != sep) { + Tcl_AppendToObj(cwdDir, &sep, 1); + cwdLen++; + /* Note: cwdStr may no longer be a valid pointer */ + } ret = (*proc)(interp, tmpResultPtr, cwdDir, pattern, types); Tcl_DecrRefCount(cwdDir); if (ret == TCL_OK) { @@ -2636,10 +2622,13 @@ Tcl_FSJoinPath(listObj, elements) int driveNameLength; Tcl_PathType type; char *strElt; + int strEltLen; + int length; + char *ptr; Tcl_Obj *driveName = NULL; Tcl_ListObjIndex(NULL, listObj, i, &elt); - strElt = Tcl_GetString(elt); + strElt = Tcl_GetStringFromObj(elt, &strEltLen); type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* Zero out the current result */ @@ -2653,6 +2642,19 @@ Tcl_FSJoinPath(listObj, elements) strElt += driveNameLength; } + ptr = Tcl_GetStringFromObj(res, &length); + + /* + * Strip off any './' before a tilde, unless this is the + * beginning of the path. + */ + if (length > 0 && strEltLen > 0) { + if ((strElt[0] == '.') && (strElt[1] == '/') + && (strElt[2] == '~')) { + strElt += 2; + } + } + /* * A NULL value for fsPtr at this stage basically means * we're trying to join a relative path onto something @@ -2664,9 +2666,7 @@ Tcl_FSJoinPath(listObj, elements) if (fsPtr == &nativeFilesystem || fsPtr == NULL) { TclpNativeJoinPath(res, strElt); } else { - int length; char separator = '/'; - char *ptr; int needsSep = 0; if (fsPtr->filesystemSeparatorProc != NULL) { @@ -2675,7 +2675,7 @@ Tcl_FSJoinPath(listObj, elements) separator = Tcl_GetString(sep)[0]; } } - ptr = Tcl_GetStringFromObj(res, &length); + if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); length++; @@ -3735,6 +3735,17 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) * to allow this sub-optimal routing. */ Tcl_FSGetFileSystemForPath(pathObjPtr); + + /* + * If we fail through here, then the path is probably not a + * valid path in the filesystsem, and is most likely to be a + * use of the empty path "" via a direct call to one of the + * objectified interfaces (e.g. from the Tcl testsuite). + */ + srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; + if (srcFsPathPtr->fsRecPtr == NULL) { + return NULL; + } } if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { @@ -3915,6 +3926,11 @@ NativeDupInternalRep(clientData) * Any path object is acceptable to the native filesystem, by * default (we will throw errors when illegal paths are actually * tried to be used). + * + * However, this behavior means the native filesystem must be + * the last filesystem in the lookup list (otherwise it will + * claim all files belong to it, and other filesystems will + * never get a look in). * * Results: * TCL_OK, to indicate 'yes', -1 to indicate no. @@ -4262,22 +4278,6 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) return 0; } -/* Wrappers */ - -static Tcl_Channel -NativeOpenFileChannel(interp, pathPtr, modeString, permissions) - Tcl_Interp *interp; - Tcl_Obj *pathPtr; - char *modeString; - int permissions; -{ - Tcl_Obj *trans = Tcl_FSGetTranslatedPath(interp, pathPtr); - if (trans == NULL) { - return NULL; - } - return TclpOpenFileChannel(interp, Tcl_GetString(trans), modeString, permissions); -} - /* * utime wants a normalized, NOT native path. I assume a native * version of 'utime' doesn't exist (at least under that name) on NT/2000. @@ -4304,27 +4304,6 @@ NativeUtime(pathPtr, tval) #endif } -static int -NativeLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) - Tcl_Interp * interp; - Tcl_Obj *pathPtr; - char * sym1; - char * sym2; - Tcl_PackageInitProc ** proc1Ptr; - Tcl_PackageInitProc ** proc2Ptr; - ClientData * clientDataPtr; -{ - char *path; - Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - if (transPtr == NULL) { - path = NULL; - } else { - path = Tcl_GetString(transPtr); - } - return TclpLoadFile(interp, path, - sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr); -} - /* Everything from here on is contained in this obsolete ifdef */ #ifdef USE_OBSOLETE_FS_HOOKS |