summaryrefslogtreecommitdiffstats
path: root/generic/tclIOUtil.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-09-27 19:40:30 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-09-27 19:40:30 (GMT)
commit415263df239b3d23328d8af5672477b6d5d7c77c (patch)
tree8179cdd91f8a3f430804a51214594df0ea844a3f /generic/tclIOUtil.c
parentf275a7d75401fe7aca194722e9d20c7e58ec9169 (diff)
downloadtcl-415263df239b3d23328d8af5672477b6d5d7c77c.zip
tcl-415263df239b3d23328d8af5672477b6d5d7c77c.tar.gz
tcl-415263df239b3d23328d8af5672477b6d5d7c77c.tar.bz2
Stylistic improvements (consistent function separation standards, etc.) and
some reduction in nesting in functions.
Diffstat (limited to 'generic/tclIOUtil.c')
-rw-r--r--generic/tclIOUtil.c644
1 files changed, 320 insertions, 324 deletions
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 93bdc4b..b610af4 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.155 2008/07/28 21:31:15 nijtmans Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.156 2008/09/27 19:40:30 dkf Exp $
*/
#include "tclInt.h"
@@ -51,187 +51,7 @@ static void FsRecacheFilesystemList(void);
MODULE_SCOPE const char * tclpFileAttrStrings[];
MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
-
-/*
- * The following functions are obsolete string based APIs, and should be
- * removed in a future release (Tcl 9 would be a good time).
- */
-
-
-/* Obsolete */
-int
-Tcl_Stat(
- const char *path, /* Path of file to stat (in current CP). */
- struct stat *oldStyleBuf) /* Filled with results of stat call. */
-{
- int ret;
- Tcl_StatBuf buf;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
-#ifndef TCL_WIDE_INT_IS_LONG
- Tcl_WideInt tmp1, tmp2;
-#ifdef HAVE_ST_BLOCKS
- Tcl_WideInt tmp3;
-#endif
-#endif
-
- Tcl_IncrRefCount(pathPtr);
- ret = Tcl_FSStat(pathPtr, &buf);
- Tcl_DecrRefCount(pathPtr);
- if (ret != -1) {
-#ifndef TCL_WIDE_INT_IS_LONG
-# define OUT_OF_RANGE(x) \
- (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
- ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
-# define OUT_OF_URANGE(x) \
- (((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))
-
- /*
- * Perform the result-buffer overflow check manually.
- *
- * Note that ino_t/ino64_t is unsigned...
- *
- * Workaround gcc warning of "comparison is always false due to
- * limited range of data type" by assigning to tmp var of type
- * Tcl_WideInt.
- */
-
- tmp1 = (Tcl_WideInt) buf.st_ino;
- tmp2 = (Tcl_WideInt) buf.st_size;
-#ifdef HAVE_ST_BLOCKS
- tmp3 = (Tcl_WideInt) buf.st_blocks;
-#endif
-
- if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2)
-#ifdef HAVE_ST_BLOCKS
- || OUT_OF_RANGE(tmp3)
-#endif
- ) {
-#ifdef EFBIG
- errno = EFBIG;
-#else
-# ifdef EOVERFLOW
- errno = EOVERFLOW;
-# else
-# error "What status should be returned for file size out of range?"
-# endif
-#endif
- return -1;
- }
-
-# undef OUT_OF_RANGE
-# undef OUT_OF_URANGE
-#endif /* !TCL_WIDE_INT_IS_LONG */
-
- /*
- * Copy across all supported fields, with possible type coercions on
- * those fields that change between the normal and lf64 versions of
- * the stat structure (on Solaris at least). This is slow when the
- * structure sizes coincide, but that's what you get for using an
- * obsolete interface.
- */
-
- oldStyleBuf->st_mode = buf.st_mode;
- oldStyleBuf->st_ino = (ino_t) buf.st_ino;
- oldStyleBuf->st_dev = buf.st_dev;
- oldStyleBuf->st_rdev = buf.st_rdev;
- oldStyleBuf->st_nlink = buf.st_nlink;
- oldStyleBuf->st_uid = buf.st_uid;
- oldStyleBuf->st_gid = buf.st_gid;
- oldStyleBuf->st_size = (off_t) buf.st_size;
- oldStyleBuf->st_atime = buf.st_atime;
- oldStyleBuf->st_mtime = buf.st_mtime;
- oldStyleBuf->st_ctime = buf.st_ctime;
-#ifdef HAVE_ST_BLOCKS
- oldStyleBuf->st_blksize = buf.st_blksize;
- oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks;
-#endif
- }
- return ret;
-}
-
-/* Obsolete */
-int
-Tcl_Access(
- const char *path, /* Path of file to access (in current CP). */
- int mode) /* Permission setting. */
-{
- int ret;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
-
- Tcl_IncrRefCount(pathPtr);
- ret = Tcl_FSAccess(pathPtr,mode);
- Tcl_DecrRefCount(pathPtr);
-
- return ret;
-}
-
-/* Obsolete */
-Tcl_Channel
-Tcl_OpenFileChannel(
- Tcl_Interp *interp, /* Interpreter for error reporting; can be
- * NULL. */
- const char *path, /* Name of file to open. */
- const char *modeString, /* A list of POSIX open modes or a string such
- * as "rw". */
- int permissions) /* If the open involves creating a file, with
- * what modes to create it? */
-{
- Tcl_Channel ret;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
-
- Tcl_IncrRefCount(pathPtr);
- ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
- Tcl_DecrRefCount(pathPtr);
-
- return ret;
-}
-
-/* Obsolete */
-int
-Tcl_Chdir(
- const char *dirName)
-{
- int ret;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
- Tcl_IncrRefCount(pathPtr);
- ret = Tcl_FSChdir(pathPtr);
- Tcl_DecrRefCount(pathPtr);
- return ret;
-}
-
-/* Obsolete */
-char *
-Tcl_GetCwd(
- Tcl_Interp *interp,
- Tcl_DString *cwdPtr)
-{
- Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
-
- if (cwd == NULL) {
- return NULL;
- }
- Tcl_DStringInit(cwdPtr);
- Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
- Tcl_DecrRefCount(cwd);
- return Tcl_DStringValue(cwdPtr);
-}
-
-/* Obsolete */
-int
-Tcl_EvalFile(
- Tcl_Interp *interp, /* Interpreter in which to process file. */
- const char *fileName) /* Name of file to process. Tilde-substitution
- * will be performed on this name. */
-{
- int ret;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
-
- Tcl_IncrRefCount(pathPtr);
- ret = Tcl_FSEvalFile(interp, pathPtr);
- Tcl_DecrRefCount(pathPtr);
- return ret;
-}
-
+
/*
* The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
* complete, general hooked filesystem APIs should be used instead. This
@@ -245,8 +65,6 @@ Tcl_EvalFile(
* support, I suggest all these hooks are removed.
*/
-
-
/*
* Declare the native filesystem support. These functions should be considered
* private to Tcl, and should really not be called directly by any code other
@@ -408,7 +226,186 @@ typedef struct FsDivertLoad {
const Tcl_Filesystem *divertedFilesystem;
ClientData divertedFileNativeRep;
} FsDivertLoad;
+
+/*
+ * The following functions are obsolete string based APIs, and should be
+ * removed in a future release (Tcl 9 would be a good time).
+ */
+
+/* Obsolete */
+int
+Tcl_Stat(
+ const char *path, /* Path of file to stat (in current CP). */
+ struct stat *oldStyleBuf) /* Filled with results of stat call. */
+{
+ int ret;
+ Tcl_StatBuf buf;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt tmp1, tmp2;
+#ifdef HAVE_ST_BLOCKS
+ Tcl_WideInt tmp3;
+#endif
+#endif
+
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSStat(pathPtr, &buf);
+ Tcl_DecrRefCount(pathPtr);
+ if (ret != -1) {
+#ifndef TCL_WIDE_INT_IS_LONG
+# define OUT_OF_RANGE(x) \
+ (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
+ ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
+# define OUT_OF_URANGE(x) \
+ (((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))
+
+ /*
+ * Perform the result-buffer overflow check manually.
+ *
+ * Note that ino_t/ino64_t is unsigned...
+ *
+ * Workaround gcc warning of "comparison is always false due to
+ * limited range of data type" by assigning to tmp var of type
+ * Tcl_WideInt.
+ */
+
+ tmp1 = (Tcl_WideInt) buf.st_ino;
+ tmp2 = (Tcl_WideInt) buf.st_size;
+#ifdef HAVE_ST_BLOCKS
+ tmp3 = (Tcl_WideInt) buf.st_blocks;
+#endif
+
+ if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2)
+#ifdef HAVE_ST_BLOCKS
+ || OUT_OF_RANGE(tmp3)
+#endif
+ ) {
+#ifdef EFBIG
+ errno = EFBIG;
+#else
+# ifdef EOVERFLOW
+ errno = EOVERFLOW;
+# else
+# error "What status should be returned for file size out of range?"
+# endif
+#endif
+ return -1;
+ }
+
+# undef OUT_OF_RANGE
+# undef OUT_OF_URANGE
+#endif /* !TCL_WIDE_INT_IS_LONG */
+
+ /*
+ * Copy across all supported fields, with possible type coercions on
+ * those fields that change between the normal and lf64 versions of
+ * the stat structure (on Solaris at least). This is slow when the
+ * structure sizes coincide, but that's what you get for using an
+ * obsolete interface.
+ */
+ oldStyleBuf->st_mode = buf.st_mode;
+ oldStyleBuf->st_ino = (ino_t) buf.st_ino;
+ oldStyleBuf->st_dev = buf.st_dev;
+ oldStyleBuf->st_rdev = buf.st_rdev;
+ oldStyleBuf->st_nlink = buf.st_nlink;
+ oldStyleBuf->st_uid = buf.st_uid;
+ oldStyleBuf->st_gid = buf.st_gid;
+ oldStyleBuf->st_size = (off_t) buf.st_size;
+ oldStyleBuf->st_atime = buf.st_atime;
+ oldStyleBuf->st_mtime = buf.st_mtime;
+ oldStyleBuf->st_ctime = buf.st_ctime;
+#ifdef HAVE_ST_BLOCKS
+ oldStyleBuf->st_blksize = buf.st_blksize;
+ oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks;
+#endif
+ }
+ return ret;
+}
+
+/* Obsolete */
+int
+Tcl_Access(
+ const char *path, /* Path of file to access (in current CP). */
+ int mode) /* Permission setting. */
+{
+ int ret;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSAccess(pathPtr,mode);
+ Tcl_DecrRefCount(pathPtr);
+
+ return ret;
+}
+
+/* Obsolete */
+Tcl_Channel
+Tcl_OpenFileChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting; can be
+ * NULL. */
+ const char *path, /* Name of file to open. */
+ const char *modeString, /* A list of POSIX open modes or a string such
+ * as "rw". */
+ int permissions) /* If the open involves creating a file, with
+ * what modes to create it? */
+{
+ Tcl_Channel ret;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
+ Tcl_DecrRefCount(pathPtr);
+
+ return ret;
+}
+
+/* Obsolete */
+int
+Tcl_Chdir(
+ const char *dirName)
+{
+ int ret;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSChdir(pathPtr);
+ Tcl_DecrRefCount(pathPtr);
+ return ret;
+}
+
+/* Obsolete */
+char *
+Tcl_GetCwd(
+ Tcl_Interp *interp,
+ Tcl_DString *cwdPtr)
+{
+ Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
+
+ if (cwd == NULL) {
+ return NULL;
+ }
+ Tcl_DStringInit(cwdPtr);
+ Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
+ Tcl_DecrRefCount(cwd);
+ return Tcl_DStringValue(cwdPtr);
+}
+
+/* Obsolete */
+int
+Tcl_EvalFile(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ const char *fileName) /* Name of file to process. Tilde-substitution
+ * will be performed on this name. */
+{
+ int ret;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
+
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSEvalFile(interp, pathPtr);
+ Tcl_DecrRefCount(pathPtr);
+ return ret;
+}
+
/*
* Now move on to the basic filesystem implementation
*/
@@ -446,7 +443,7 @@ FsThrExitProc(
}
tsdPtr->initialized = 0;
}
-
+
int
TclFSCwdIsNative(void)
{
@@ -458,7 +455,7 @@ TclFSCwdIsNative(void)
return 0;
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -542,7 +539,7 @@ TclFSCwdPointerEquals(
}
}
}
-
+
#ifdef TCL_THREADS
static void
FsRecacheFilesystemList(void)
@@ -604,7 +601,7 @@ FsRecacheFilesystemList(void)
}
}
#endif /* TCL_THREADS */
-
+
static FilesystemRecord *
FsGetFirstFilesystem(void)
{
@@ -626,7 +623,7 @@ FsGetFirstFilesystem(void)
#endif
return fsRecPtr;
}
-
+
/*
* The epoch can be changed both by filesystems being added or removed and by
* env(HOME) changing.
@@ -637,10 +634,11 @@ TclFSEpochOk(
int filesystemEpoch)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+
(void) FsGetFirstFilesystem();
return (filesystemEpoch == tsdPtr->filesystemEpoch);
}
-
+
/*
* If non-NULL, clientData is owned by us and must be freed later.
*/
@@ -699,7 +697,7 @@ FsUpdateCwd(
Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -771,7 +769,7 @@ TclFinalizeFilesystem(void)
TclWinEncodingsCleanup();
#endif
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -807,7 +805,7 @@ TclResetFilesystem(void)
TclWinResetInterfaces();
#endif
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -841,7 +839,7 @@ TclResetFilesystem(void)
int
Tcl_FSRegister(
ClientData clientData, /* Client specific data for this fs */
- const Tcl_Filesystem *fsPtr) /* The filesystem record for the new fs. */
+ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */
{
FilesystemRecord *newFilesystemPtr;
@@ -893,7 +891,7 @@ Tcl_FSRegister(
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -969,7 +967,7 @@ Tcl_FSUnregister(
Tcl_MutexUnlock(&filesystemMutex);
return retVal;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1053,8 +1051,8 @@ Tcl_FSMatchInDirectory(
Tcl_SetErrno(ENOENT);
return -1;
}
- ret = (*fsPtr->matchInDirectoryProc)(interp, resultPtr, pathPtr,
- pattern, types);
+ ret = fsPtr->matchInDirectoryProc(interp, resultPtr, pathPtr, pattern,
+ types);
if (ret == TCL_OK && pattern != NULL) {
FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types);
}
@@ -1094,8 +1092,8 @@ Tcl_FSMatchInDirectory(
if (fsPtr != NULL && fsPtr->matchInDirectoryProc != NULL) {
TclNewObj(tmpResultPtr);
Tcl_IncrRefCount(tmpResultPtr);
- ret = (*fsPtr->matchInDirectoryProc)(interp, tmpResultPtr, cwd,
- pattern, types);
+ ret = fsPtr->matchInDirectoryProc(interp, tmpResultPtr, cwd, pattern,
+ types);
if (ret == TCL_OK) {
FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);
@@ -1115,7 +1113,7 @@ Tcl_FSMatchInDirectory(
Tcl_DecrRefCount(cwd);
return ret;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1220,7 +1218,7 @@ FsAddMountsToGlobResult(
endOfMounts:
Tcl_DecrRefCount(mounts);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1289,7 +1287,7 @@ Tcl_FSMountsChanged(
theFilesystemEpoch++;
Tcl_MutexUnlock(&filesystemMutex);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1331,7 +1329,7 @@ Tcl_FSData(
return retVal;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -1424,7 +1422,7 @@ TclFSNormalizeToUniquePath(
return startAt;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -1454,7 +1452,7 @@ TclGetOpenMode(
int binary = 0;
return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -1661,27 +1659,14 @@ TclGetOpenModeEx(
}
return mode;
}
-
-/*
- * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
- */
-
-int
-Tcl_FSEvalFile(
- Tcl_Interp *interp, /* Interpreter in which to process file. */
- Tcl_Obj *pathPtr) /* Path of file to process. Tilde-substitution
- * will be performed on this name. */
-{
- return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
-}
-
+
/*
*----------------------------------------------------------------------
*
- * Tcl_FSEvalFileEx --
+ * Tcl_FSEvalFile, Tcl_FSEvalFileEx --
*
* Read in a file and process the entire file as one gigantic Tcl
- * command.
+ * command. Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
*
* Results:
* A standard Tcl result, which is either the result of executing the
@@ -1696,6 +1681,15 @@ Tcl_FSEvalFile(
*/
int
+Tcl_FSEvalFile(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ Tcl_Obj *pathPtr) /* Path of file to process. Tilde-substitution
+ * will be performed on this name. */
+{
+ return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
+}
+
+int
Tcl_FSEvalFileEx(
Tcl_Interp *interp, /* Interpreter in which to process file. */
Tcl_Obj *pathPtr, /* Path of file to process. Tilde-substitution
@@ -1807,7 +1801,7 @@ Tcl_FSEvalFileEx(
Tcl_DecrRefCount(objPtr);
return result;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1837,13 +1831,15 @@ Tcl_GetErrno(void)
return errno;
}
-
+
/*
*----------------------------------------------------------------------
*
* Tcl_SetErrno --
*
- * Sets the Tcl error code variable to the supplied value.
+ * Sets the Tcl error code variable to the supplied value. On some saner
+ * platforms this is actually a thread-local (this is implemented in the
+ * C library) but this is *really* unsafe to assume!
*
* Results:
* None.
@@ -1865,7 +1861,7 @@ Tcl_SetErrno(
errno = err;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1899,7 +1895,7 @@ Tcl_PosixError(
}
return msg;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1932,7 +1928,7 @@ Tcl_FSStat(
Tcl_SetErrno(ENOENT);
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1970,7 +1966,7 @@ Tcl_FSLstat(
Tcl_SetErrno(ENOENT);
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2001,7 +1997,7 @@ Tcl_FSAccess(
Tcl_SetErrno(ENOENT);
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2097,7 +2093,7 @@ Tcl_FSOpenFileChannel(
}
return NULL;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2129,7 +2125,7 @@ Tcl_FSUtime(
/* TODO: set errno here? Tcl_SetErrno(ENOENT); */
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2157,7 +2153,7 @@ NativeFileAttrStrings(
{
return tclpFileAttrStrings;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2187,10 +2183,9 @@ NativeFileAttrsGet(
Tcl_Obj *pathPtr, /* path of file we are operating on. */
Tcl_Obj **objPtrRef) /* for output. */
{
- return (*tclpFileAttrProcs[index].getProc)(interp, index, pathPtr,
- objPtrRef);
+ return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2217,9 +2212,9 @@ NativeFileAttrsSet(
Tcl_Obj *pathPtr, /* path of file we are operating on. */
Tcl_Obj *objPtr) /* set to this value. */
{
- return (*tclpFileAttrProcs[index].setProc)(interp, index, pathPtr, objPtr);
+ return tclpFileAttrProcs[index].setProc(interp, index, pathPtr, objPtr);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2257,7 +2252,7 @@ Tcl_FSFileAttrStrings(
Tcl_SetErrno(ENOENT);
return NULL;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2334,7 +2329,7 @@ TclFSFileAttrIndex(
return TCL_ERROR;
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2371,7 +2366,7 @@ Tcl_FSFileAttrsGet(
Tcl_SetErrno(ENOENT);
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2405,7 +2400,7 @@ Tcl_FSFileAttrsSet(
Tcl_SetErrno(ENOENT);
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2481,7 +2476,7 @@ Tcl_FSGetCwd(
Tcl_Obj *norm;
/* Looks like a new current directory */
- retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(retCd);
+ retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd);
Tcl_IncrRefCount(retVal);
norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL);
if (norm != NULL) {
@@ -2500,7 +2495,7 @@ Tcl_FSGetCwd(
FsUpdateCwd(norm, retCd);
Tcl_DecrRefCount(norm);
} else {
- (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
+ fsRecPtr->fsPtr->freeInternalRepProc(retCd);
}
Tcl_DecrRefCount(retVal);
retVal = NULL;
@@ -2667,7 +2662,7 @@ Tcl_FSGetCwd(
return tsdPtr->cwdPathPtr;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2815,7 +2810,7 @@ Tcl_FSChdir(
return retVal;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2898,7 +2893,7 @@ Tcl_FSLoadFile(
*handlePtr = clientData;
return res;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -3222,6 +3217,7 @@ TclLoadFile(
}
return TCL_OK;
}
+
/*
* This function used to be in the platform specific directories, but it has
* now been made to work cross-platform
@@ -3265,7 +3261,7 @@ TclpLoadFile(
*proc2Ptr = TclpFindSymbol(interp, handle, sym2);
return TCL_OK;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -3310,7 +3306,7 @@ FSUnloadTempFile(
*/
if (tvdlPtr->unloadProcPtr != NULL) {
- (*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
+ tvdlPtr->unloadProcPtr(tvdlPtr->loadHandle);
}
if (tvdlPtr->divertedFilesystem == NULL) {
@@ -3358,7 +3354,7 @@ FSUnloadTempFile(
ckfree((char *) tvdlPtr);
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -3419,7 +3415,7 @@ Tcl_FSLink(
#endif /* S_IFLNK */
return NULL;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -3473,7 +3469,7 @@ Tcl_FSListVolumes(void)
return resultPtr;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -3523,7 +3519,7 @@ FsListMounts(
return resultPtr;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -3573,7 +3569,7 @@ Tcl_FSSplitPath(
*/
if (fsPtr->filesystemSeparatorProc != NULL) {
- Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);
+ Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(pathPtr);
if (sep != NULL) {
Tcl_IncrRefCount(sep);
@@ -3653,9 +3649,9 @@ TclFSInternalToNormalized(
|| (fromFilesystem->internalToNormalizedProc == NULL)) {
return NULL;
}
- return (*fromFilesystem->internalToNormalizedProc)(clientData);
+ return fromFilesystem->internalToNormalizedProc(clientData);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -3707,7 +3703,7 @@ TclGetPathType(
}
return type;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -3760,21 +3756,20 @@ TclFSNonnativePathType(
while (fsRecPtr != NULL) {
/*
* We want to skip the native filesystem in this loop because
- * otherwise we won't necessarily pass all the Tcl testsuite -- this
- * is because some of the tests artificially change the current
- * platform (between win, unix) but the list of volumes we get by
- * calling fsRecPtr->fsPtr->listVolumesProc will reflect the current
- * (real) platform only and this may cause some tests to fail. In
- * particular, on Unix '/' will match the beginning of certain
- * absolute Windows paths starting '//' and those tests will go wrong.
+ * otherwise we won't necessarily pass all the Tcl testsuite - this is
+ * because some of the tests artificially change the current platform
+ * (between win, unix) but the list of volumes we get by calling
+ * fsRecPtr->fsPtr->listVolumesProc will reflect the current (real)
+ * platform only and this may cause some tests to fail. In particular,
+ * on Unix '/' will match the beginning of certain absolute Windows
+ * paths starting '//' and those tests will go wrong.
*
* Besides these test-suite issues, there is one other reason to skip
- * the native filesystem --- since the tclFilename.c code has nice
- * fast 'absolute path' checkers, we don't want to waste time
- * repeating that effort here, and this function is actually called
- * quite often, so if we can save the overhead of the native
- * filesystem returning us a list of volumes all the time, it is
- * better.
+ * the native filesystem - since the tclFilename.c code has nice fast
+ * 'absolute path' checkers, we don't want to waste time repeating
+ * that effort here, and this function is actually called quite often,
+ * so if we can save the overhead of the native filesystem returning
+ * us a list of volumes all the time, it is better.
*/
if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
@@ -3837,7 +3832,7 @@ TclFSNonnativePathType(
}
return type;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -3878,7 +3873,7 @@ Tcl_FSRenameFile(
}
return retVal;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -3920,7 +3915,7 @@ Tcl_FSCopyFile(
}
return retVal;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -3998,7 +3993,7 @@ TclCrossFilesystemCopy(
done:
return result;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4028,7 +4023,7 @@ Tcl_FSDeleteFile(
Tcl_SetErrno(ENOENT);
return -1;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4058,7 +4053,7 @@ Tcl_FSCreateDirectory(
Tcl_SetErrno(ENOENT);
return -1;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4100,7 +4095,7 @@ Tcl_FSCopyDirectory(
}
return retVal;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4131,46 +4126,47 @@ Tcl_FSRemoveDirectory(
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL && fsPtr->removeDirectoryProc != NULL) {
- if (recursive) {
- /*
- * We check whether the cwd lies inside this directory and move it
- * if it does.
- */
+ if (fsPtr == NULL || fsPtr->removeDirectoryProc == NULL) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
- Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
+ /*
+ * When working recursively, we check whether the cwd lies inside this
+ * directory and move it if it does.
+ */
+
+ if (recursive) {
+ Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
- if (cwdPtr != NULL) {
- char *cwdStr, *normPathStr;
- int cwdLen, normLen;
- Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (cwdPtr != NULL) {
+ char *cwdStr, *normPathStr;
+ int cwdLen, normLen;
+ Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
- if (normPath != NULL) {
- normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
- cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
- if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
- (size_t) normLen) == 0)) {
- /*
- * The cwd is inside the directory, so we perform a
- * 'cd [file dirname $path]'.
- */
+ if (normPath != NULL) {
+ normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
+ cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
+ if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
+ (size_t) normLen) == 0)) {
+ /*
+ * The cwd is inside the directory, so we perform a 'cd
+ * [file dirname $path]'.
+ */
- Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
- TCL_PATH_DIRNAME);
+ Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
+ TCL_PATH_DIRNAME);
- Tcl_FSChdir(dirPtr);
- Tcl_DecrRefCount(dirPtr);
- }
+ Tcl_FSChdir(dirPtr);
+ Tcl_DecrRefCount(dirPtr);
}
- Tcl_DecrRefCount(cwdPtr);
}
+ Tcl_DecrRefCount(cwdPtr);
}
- return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
}
- Tcl_SetErrno(ENOENT);
- return -1;
+ return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4253,7 +4249,7 @@ Tcl_FSGetFileSystemForPath(
return NULL;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4289,7 +4285,7 @@ Tcl_FSGetNativePath(
{
return (const char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4312,7 +4308,7 @@ NativeFreeInternalRep(
{
ckfree((char *) clientData);
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4356,7 +4352,7 @@ Tcl_FSFileSystemInfo(
return resPtr;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4381,25 +4377,25 @@ Tcl_FSPathSeparator(
Tcl_Obj *pathPtr)
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ Tcl_Obj *resultObj;
if (fsPtr == NULL) {
return NULL;
}
+
if (fsPtr->filesystemSeparatorProc != NULL) {
- return (*fsPtr->filesystemSeparatorProc)(pathPtr);
- } else {
- Tcl_Obj *resultObj;
+ return fsPtr->filesystemSeparatorProc(pathPtr);
+ }
- /*
- * Allow filesystems not to provide a filesystemSeparatorProc if they
- * wish to use the standard forward slash.
- */
+ /*
+ * Allow filesystems not to provide a filesystemSeparatorProc if they wish
+ * to use the standard forward slash.
+ */
- TclNewLiteralStringObj(resultObj, "/");
- return resultObj;
- }
+ TclNewLiteralStringObj(resultObj, "/");
+ return resultObj;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -4422,6 +4418,7 @@ NativeFilesystemSeparator(
Tcl_Obj *pathPtr)
{
const char *separator = NULL; /* lint */
+
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separator = "/";
@@ -4432,8 +4429,7 @@ NativeFilesystemSeparator(
}
return Tcl_NewStringObj(separator,1);
}
-
-
+
/*
* Local Variables:
* mode: c