summaryrefslogtreecommitdiffstats
path: root/generic/tclIOUtil.c
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2001-08-30 08:53:14 (GMT)
committervincentdarley <vincentdarley>2001-08-30 08:53:14 (GMT)
commit209cbd9eea8f0938d87548bdea9bd8970d18a1fb (patch)
treecf952115d99a903d3c817b01278505ed6aaff55d /generic/tclIOUtil.c
parentea7d3c538d82fb64a201fedfb9376f6dcafbd102 (diff)
downloadtcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.zip
tcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.tar.gz
tcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.tar.bz2
filesystem
Diffstat (limited to 'generic/tclIOUtil.c')
-rw-r--r--generic/tclIOUtil.c145
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