summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/regex.h4
-rw-r--r--generic/tclCompile.h26
-rw-r--r--generic/tclFileName.c147
-rw-r--r--generic/tclFileSystem.h6
-rw-r--r--generic/tclIO.h4
-rw-r--r--generic/tclIOUtil.c717
-rw-r--r--generic/tclInt.h8
-rw-r--r--generic/tclRegexp.h4
8 files changed, 507 insertions, 409 deletions
diff --git a/generic/regex.h b/generic/regex.h
index fa86092..f6d4eb4 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -104,8 +104,8 @@ extern "C" {
/* interface types */
#define __REG_WIDE_T Tcl_UniChar
#define __REG_REGOFF_T long /* not really right, but good enough... */
-#define __REG_VOID_T VOID
-#define __REG_CONST CONST
+#define __REG_VOID_T void
+#define __REG_CONST const
/* names and declarations */
#define __REG_WIDE_COMPILE TclReComp
#define __REG_WIDE_EXEC TclReExec
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index eee0da9..06447df 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.h,v 1.90 2008/02/26 20:28:59 jenglish Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.91 2008/05/02 10:27:05 dkf Exp $
*/
#ifndef _TCLCOMPILATION
@@ -833,7 +833,7 @@ typedef struct {
MODULE_SCOPE int TclEvalObjvInternal(Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[],
- CONST char *command, int length, int flags);
+ const char *command, int length, int flags);
/*
*----------------------------------------------------------------
* Procedures exported by the engine to be used by tclBasic.c
@@ -854,13 +854,13 @@ MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr);
MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
CompileEnv *envPtr);
-MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, CONST char *script,
+MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script,
int numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int numWords,
CompileEnv *envPtr);
MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp,
- CONST char *script, int numBytes,
+ const char *script, int numBytes,
CompileEnv *envPtr);
MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp,
CompileEnv *envPtr);
@@ -887,7 +887,7 @@ MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int TclExecuteByteCode(Tcl_Interp *interp,
ByteCode *codePtr);
MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void);
-MODULE_SCOPE int TclFindCompiledLocal(CONST char *name, int nameChars,
+MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
int create, Proc *procPtr);
MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp,
Tcl_Obj *objPtr);
@@ -902,7 +902,7 @@ MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
MODULE_SCOPE void TclInitCompilation(void);
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
CompileEnv *envPtr, const char *string,
- int numBytes, CONST CmdFrame* invoker, int word);
+ int numBytes, const CmdFrame* invoker, int word);
MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr);
#ifdef TCL_COMPILE_STATS
@@ -918,23 +918,23 @@ MODULE_SCOPE int TclPrintInstruction(ByteCode* codePtr,
MODULE_SCOPE void TclPrintObject(FILE *outFile,
Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void TclPrintSource(FILE *outFile,
- CONST char *string, int maxChars);
+ const char *string, int maxChars);
MODULE_SCOPE void TclRegisterAuxDataType(AuxDataType *typePtr);
MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
char *bytes, int length, int flags);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int TclSortingOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr);
MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
@@ -954,7 +954,7 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
/*
* Form of TclRegisterLiteral with onHeap == 0. In that case, it is safe to
- * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ * cast away constness, and it is cleanest to do that here, all in one place.
*
* int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
* int length);
@@ -965,7 +965,7 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
/*
* Form of TclRegisterNSLiteral with onHeap == 0. In that case, it is safe to
- * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ * cast away constness, and it is cleanest to do that here, all in one place.
*
* int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
* int length);
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 80391f7..5c58052 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFileName.c,v 1.86 2007/12/13 15:23:17 dgp Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.87 2008/05/02 10:27:05 dkf Exp $
*/
#include "tclInt.h"
@@ -34,8 +34,8 @@ static const char * ExtractWinRoot(const char *path,
Tcl_DString *resultPtr, int offset,
Tcl_PathType *typePtr);
static int SkipToChar(char **stringPtr, int match);
-static Tcl_Obj* SplitWinPath(const char *path);
-static Tcl_Obj* SplitUnixPath(const char *path);
+static Tcl_Obj * SplitWinPath(const char *path);
+static Tcl_Obj * SplitUnixPath(const char *path);
static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr,
const char *separators, Tcl_Obj *pathPtr, int flags,
char *pattern, Tcl_GlobTypeData *types);
@@ -201,7 +201,7 @@ ExtractWinRoot(
Tcl_DStringAppend(resultPtr, path, 2);
return &path[2];
} else {
- char *tail = (char*)&path[3];
+ char *tail = (char *) &path[3];
/*
* Skip separators.
@@ -1412,8 +1412,8 @@ Tcl_GlobObjCmd(
*/
Tcl_ListObjLength(interp, typePtr, &length);
- globTypes = (Tcl_GlobTypeData*)
- TclStackAlloc(interp,sizeof(Tcl_GlobTypeData));
+ globTypes = (Tcl_GlobTypeData *)
+ TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
globTypes->type = 0;
globTypes->perm = 0;
globTypes->macType = NULL;
@@ -1477,7 +1477,7 @@ Tcl_GlobObjCmd(
Tcl_IncrRefCount(look);
} else {
- Tcl_Obj* item;
+ Tcl_Obj *item;
if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
(len == 3)) {
@@ -1882,27 +1882,29 @@ TclGlob(
if (*tail == '\0' && pathPrefix != NULL) {
/*
- * An empty pattern. This means 'pathPrefix' is actually
- * a full path of a file/directory we want to simply check
- * for existence and type.
+ * An empty pattern. This means 'pathPrefix' is actually a full path
+ * of a file/directory we want to simply check for existence and type.
*/
+
if (types == NULL) {
/*
- * We just want to check for existence. In this case we
- * make it easy on Tcl_FSMatchInDirectory and its
- * sub-implementations by not bothering them (even though
- * they should support this situation) and we just use the
- * simple existence check with Tcl_FSAccess.
+ * We just want to check for existence. In this case we make it
+ * easy on Tcl_FSMatchInDirectory and its sub-implementations by
+ * not bothering them (even though they should support this
+ * situation) and we just use the simple existence check with
+ * Tcl_FSAccess.
*/
+
if (Tcl_FSAccess(pathPrefix, F_OK) == 0) {
Tcl_ListObjAppendElement(interp, filenamesObj, pathPrefix);
}
result = TCL_OK;
} else {
/*
- * We want to check for the correct type. Tcl_FSMatchInDirectory
+ * We want to check for the correct type. Tcl_FSMatchInDirectory
* is documented to do this for us, if we give it a NULL pattern.
*/
+
result = Tcl_FSMatchInDirectory(interp, filenamesObj, pathPrefix,
NULL, types);
}
@@ -1968,7 +1970,7 @@ TclGlob(
for (i = 0; i< objc; i++) {
int len;
char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
- Tcl_Obj* elems[1];
+ Tcl_Obj *elems[1];
if (len == prefixLen) {
if ((pattern[0] == '\0')
@@ -2095,7 +2097,7 @@ DoGlob(
* resulting filenames. Caller allocates and
* deallocates; DoGlob must not touch the
* refCount of this object. */
- const char *separators, /* String containing separator characters that
+ const char *separators, /* String containing separator characters that
* should be used to identify globbing
* boundaries. */
Tcl_Obj *pathPtr, /* Completely expanded prefix. */
@@ -2327,7 +2329,7 @@ DoGlob(
TCL_GLOB_TYPE_DIR, 0, NULL, NULL
};
char save = *p;
- Tcl_Obj* subdirsPtr;
+ Tcl_Obj *subdirsPtr;
if (*p == '\0') {
return Tcl_FSMatchInDirectory(interp, matchesObj, pathPtr,
@@ -2521,6 +2523,113 @@ Tcl_AllocStatBuf(void)
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_Get*FromStat --
+ *
+ * These functions provide portable read-only access to a Tcl_StatBuf.
+ *
+ * Results:
+ * The contents of the relevant field.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+unsigned
+Tcl_GetFSDeviceFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_dev;
+}
+
+unsigned
+Tcl_GetFSInodeFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_ino;
+}
+
+unsigned
+Tcl_GetModeFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_mode;
+}
+
+int
+Tcl_GetLinkCountFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_nlink;
+}
+
+int
+Tcl_GetUserIdFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_uid;
+}
+
+int
+Tcl_GetGroupIdFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_gid;
+}
+
+int
+Tcl_GetDeviceTypeFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_rdev;
+}
+
+Tcl_WideInt
+Tcl_GetAccessTimeFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_atime;
+}
+
+Tcl_WideInt
+Tcl_GetModificationTimeFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_mtime;
+}
+
+Tcl_WideInt
+Tcl_GetChangeTimeFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_ctime;
+}
+
+Tcl_WideUInt
+Tcl_GetSizeFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return (Tcl_WideUInt) statBufPtr->st_size;
+}
+
+Tcl_WideUInt
+Tcl_GetBlocksFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_blocks;
+}
+
+unsigned
+Tcl_GetBlockSizeFromStat(
+ Tcl_StatBuf *statBufPtr)
+{
+ return statBufPtr->st_blksize;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index cff0942..fee4d6e 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFileSystem.h,v 1.11 2005/10/13 00:07:17 dkf Exp $
+ * RCS: @(#) $Id: tclFileSystem.h,v 1.12 2008/05/02 10:27:07 dkf Exp $
*/
#ifndef _TCLFILESYSTEM
@@ -98,7 +98,7 @@ MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey;
MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr);
-MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(CONST char *pathPtr,
+MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
int pathLen, Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
@@ -107,7 +107,7 @@ MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
MODULE_SCOPE int TclFSEpochOk(int filesystemEpoch);
MODULE_SCOPE int TclFSCwdIsNative(void);
MODULE_SCOPE Tcl_Obj * TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
- CONST char *path, Tcl_Obj **useThisCwdPtr);
+ const char *path, Tcl_Obj **useThisCwdPtr);
MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 662d631..23e64a0 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIO.h,v 1.12 2008/04/07 22:53:08 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.h,v 1.13 2008/05/02 10:27:07 dkf Exp $
*/
/*
@@ -158,7 +158,7 @@ typedef struct Channel {
*/
typedef struct ChannelState {
- CONST char *channelName; /* The name of the channel instance in Tcl
+ const char *channelName; /* The name of the channel instance in Tcl
* commands. Storage is owned by the generic
* IO code, is dynamically allocated. */
int flags; /* ORed combination of the flags defined
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 420ea6f..89465a0 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.153 2008/04/27 22:21:30 dkf Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.154 2008/05/02 10:27:07 dkf Exp $
*/
#include "tclInt.h"
@@ -67,7 +67,6 @@ Tcl_Stat(
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
@@ -91,8 +90,9 @@ Tcl_Stat(
*
* 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.
+ * 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;
@@ -205,16 +205,15 @@ Tcl_GetCwd(
Tcl_Interp *interp,
Tcl_DString *cwdPtr)
{
- Tcl_Obj *cwd;
- cwd = Tcl_FSGetCwd(interp);
+ Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
+
if (cwd == NULL) {
return NULL;
- } else {
- Tcl_DStringInit(cwdPtr);
- Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
- Tcl_DecrRefCount(cwd);
- return Tcl_DStringValue(cwdPtr);
}
+ Tcl_DStringInit(cwdPtr);
+ Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
+ Tcl_DecrRefCount(cwd);
+ return Tcl_DStringValue(cwdPtr);
}
/* Obsolete */
@@ -226,6 +225,7 @@ Tcl_EvalFile(
{
int ret;
Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
+
Tcl_IncrRefCount(pathPtr);
ret = Tcl_FSEvalFile(interp, pathPtr);
Tcl_DecrRefCount(pathPtr);
@@ -379,7 +379,7 @@ TCL_DECLARE_MUTEX(filesystemMutex)
* Used to implement Tcl_FSGetCwd in a file-system independent way.
*/
-static Tcl_Obj* cwdPathPtr = NULL;
+static Tcl_Obj *cwdPathPtr = NULL;
static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)
@@ -417,7 +417,7 @@ static void
FsThrExitProc(
ClientData cd)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) cd;
+ ThreadSpecificData *tsdPtr = cd;
FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;
/*
@@ -440,7 +440,7 @@ FsThrExitProc(
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr->nextPtr;
if (--fsRecPtr->fileRefCount <= 0) {
- ckfree((char *)fsRecPtr);
+ ckfree((char *) fsRecPtr);
}
fsRecPtr = tmpFsRecPtr;
}
@@ -482,7 +482,7 @@ TclFSCwdIsNative(void)
int
TclFSCwdPointerEquals(
- Tcl_Obj** pathPtrPtr)
+ Tcl_Obj **pathPtrPtr)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
@@ -511,7 +511,7 @@ TclFSCwdPointerEquals(
Tcl_MutexUnlock(&cwdMutex);
if (tsdPtr->initialized == 0) {
- Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
+ Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
tsdPtr->initialized = 1;
}
@@ -558,7 +558,7 @@ FsRecacheFilesystemList(void)
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr->nextPtr;
if (--fsRecPtr->fileRefCount <= 0) {
- ckfree((char *)fsRecPtr);
+ ckfree((char *) fsRecPtr);
}
fsRecPtr = tmpFsRecPtr;
}
@@ -599,7 +599,7 @@ FsRecacheFilesystemList(void)
*/
if (tsdPtr->initialized == 0) {
- Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
+ Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
tsdPtr->initialized = 1;
}
}
@@ -610,6 +610,7 @@ FsGetFirstFilesystem(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
FilesystemRecord *fsRecPtr;
+
#ifndef TCL_THREADS
tsdPtr->filesystemEpoch = theFilesystemEpoch;
fsRecPtr = filesystemList;
@@ -747,13 +748,14 @@ TclFinalizeFilesystem(void)
fsRecPtr = filesystemList;
while (fsRecPtr != NULL) {
FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
+
if (fsRecPtr->fileRefCount <= 0) {
/*
* The native filesystem is static, so we don't free it.
*/
if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
- ckfree((char *)fsRecPtr);
+ ckfree((char *) fsRecPtr);
}
}
fsRecPtr = tmpFsRecPtr;
@@ -955,7 +957,7 @@ Tcl_FSUnregister(
fsRecPtr->fileRefCount--;
if (fsRecPtr->fileRefCount <= 0) {
- ckfree((char *)fsRecPtr);
+ ckfree((char *) fsRecPtr);
}
retVal = TCL_OK;
@@ -1024,7 +1026,7 @@ Tcl_FSMatchInDirectory(
Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
int resLength, i, ret = -1;
- if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
+ if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) {
/*
* We don't currently allow querying of mounts by external code (a
* valuable future step), so since we're the only function that
@@ -1382,37 +1384,42 @@ TclFSNormalizeToUniquePath(
firstFsRecPtr = FsGetFirstFilesystem();
- fsRecPtr = firstFsRecPtr;
- while (fsRecPtr != NULL) {
- if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
- Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
- if (proc != NULL) {
- startAt = (*proc)(interp, pathPtr, startAt);
- }
- break;
+ for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
+ if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
+ continue;
}
- fsRecPtr = fsRecPtr->nextPtr;
+
+ /*
+ * TODO: Assume that we always find the native file system; it should
+ * always be there...
+ */
+
+ if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
+ startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
+ startAt);
+ }
+ break;
}
- fsRecPtr = firstFsRecPtr;
- while (fsRecPtr != NULL) {
+ for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
/*
* Skip the native system next time through.
*/
- if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
- Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
- if (proc != NULL) {
- startAt = (*proc)(interp, pathPtr, startAt);
- }
+ if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
+ continue;
+ }
- /*
- * We could add an efficiency check like this:
- * if (retVal == length-of(pathPtr)) {break;}
- * but there's not much benefit.
- */
+ if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
+ startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
+ startAt);
}
- fsRecPtr = fsRecPtr->nextPtr;
+
+ /*
+ * We could add an efficiency check like this:
+ * if (retVal == length-of(pathPtr)) {break;}
+ * but there's not much benefit.
+ */
}
return startAt;
@@ -1715,7 +1722,7 @@ Tcl_FSEvalFileEx(
return result;
}
chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't read file \"",
Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
@@ -1760,8 +1767,11 @@ Tcl_FSEvalFileEx(
iPtr->scriptFile = pathPtr;
Tcl_IncrRefCount(iPtr->scriptFile);
string = Tcl_GetStringFromObj(objPtr, &length);
- /* TIP #280 Force the evaluator to open a frame for a sourced
- * file. */
+
+ /*
+ * TIP #280 Force the evaluator to open a frame for a sourced file.
+ */
+
iPtr->evalFlags |= TCL_EVAL_FILE;
result = Tcl_EvalEx(interp, string, length, 0);
@@ -1820,6 +1830,11 @@ Tcl_FSEvalFileEx(
int
Tcl_GetErrno(void)
{
+ /*
+ * On some platforms, errno is really a thread local (implemented by the C
+ * library).
+ */
+
return errno;
}
@@ -1843,6 +1858,11 @@ void
Tcl_SetErrno(
int err) /* The new value. */
{
+ /*
+ * On some platforms, errno is really a thread local (implemented by the C
+ * library).
+ */
+
errno = err;
}
@@ -1904,14 +1924,10 @@ Tcl_FSStat(
Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */
Tcl_StatBuf *buf) /* Filled with results of stat call. */
{
- const Tcl_Filesystem *fsPtr;
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSStatProc *proc = fsPtr->statProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, buf);
- }
+ if (fsPtr != NULL && fsPtr->statProc != NULL) {
+ return fsPtr->statProc(pathPtr, buf);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -1942,15 +1958,13 @@ Tcl_FSLstat(
Tcl_StatBuf *buf) /* Filled with results of stat call. */
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
if (fsPtr != NULL) {
- Tcl_FSLstatProc *proc = fsPtr->lstatProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, buf);
- } else {
- Tcl_FSStatProc *sproc = fsPtr->statProc;
- if (sproc != NULL) {
- return (*sproc)(pathPtr, buf);
- }
+ if (fsPtr->lstatProc != NULL) {
+ return fsPtr->lstatProc(pathPtr, buf);
+ }
+ if (fsPtr->statProc != NULL) {
+ return fsPtr->statProc(pathPtr, buf);
}
}
Tcl_SetErrno(ENOENT);
@@ -1979,16 +1993,11 @@ Tcl_FSAccess(
Tcl_Obj *pathPtr, /* Path of file to access (in current CP). */
int mode) /* Permission setting. */
{
- const Tcl_Filesystem *fsPtr;
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSAccessProc *proc = fsPtr->accessProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, mode);
- }
+ if (fsPtr != NULL && fsPtr->accessProc != NULL) {
+ return fsPtr->accessProc(pathPtr, mode);
}
-
Tcl_SetErrno(ENOENT);
return -1;
}
@@ -2024,7 +2033,6 @@ Tcl_FSOpenFileChannel(
const Tcl_Filesystem *fsPtr;
Tcl_Channel retVal = NULL;
-
/*
* We need this just to ensure we return the correct error messages under
* some circumstances.
@@ -2035,49 +2043,47 @@ Tcl_FSOpenFileChannel(
}
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
- if (proc != NULL) {
- int mode, seekFlag, binary;
+ if (fsPtr != NULL && fsPtr->openFileChannelProc != NULL) {
+ int mode, seekFlag, binary;
- /*
- * Parse the mode, picking up whether we want to seek to start
- * with and/or set the channel automatically into binary mode.
- */
+ /*
+ * Parse the mode, picking up whether we want to seek to start with
+ * and/or set the channel automatically into binary mode.
+ */
- mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
- if (mode == -1) {
- return NULL;
- }
+ mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
+ if (mode == -1) {
+ return NULL;
+ }
- /*
- * Do the actual open() call.
- */
+ /*
+ * Do the actual open() call.
+ */
- retVal = (*proc)(interp, pathPtr, mode, permissions);
- if (retVal == NULL) {
- return NULL;
- }
+ retVal = fsPtr->openFileChannelProc(interp, pathPtr, mode,
+ permissions);
+ if (retVal == NULL) {
+ return NULL;
+ }
- /*
- * Apply appropriate flags parsed out above.
- */
+ /*
+ * Apply appropriate flags parsed out above.
+ */
- if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt)0,
- SEEK_END) < (Tcl_WideInt)0) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "could not seek to end "
- "of file while opening \"", Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), NULL);
- }
- Tcl_Close(NULL, retVal);
- return NULL;
- }
- if (binary) {
- Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
+ if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END)
+ < (Tcl_WideInt) 0) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "could not seek to end of file "
+ "while opening \"", Tcl_GetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), NULL);
}
- return retVal;
+ Tcl_Close(NULL, retVal);
+ return NULL;
+ }
+ if (binary) {
+ Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
}
+ return retVal;
}
/*
@@ -2116,12 +2122,11 @@ Tcl_FSUtime(
* times to use. Should not be modified. */
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, tval);
- }
+
+ if (fsPtr != NULL && fsPtr->utimeProc != NULL) {
+ return fsPtr->utimeProc(pathPtr, tval);
}
+ /* TODO: set errno here? Tcl_SetErrno(ENOENT); */
return -1;
}
@@ -2246,11 +2251,8 @@ Tcl_FSFileAttrStrings(
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, objPtrRef);
- }
+ if (fsPtr != NULL && fsPtr->fileAttrStringsProc != NULL) {
+ return fsPtr->fileAttrStringsProc(pathPtr, objPtrRef);
}
Tcl_SetErrno(ENOENT);
return NULL;
@@ -2363,11 +2365,8 @@ Tcl_FSFileAttrsGet(
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
- if (proc != NULL) {
- return (*proc)(interp, index, pathPtr, objPtrRef);
- }
+ if (fsPtr != NULL && fsPtr->fileAttrsGetProc != NULL) {
+ return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -2400,11 +2399,8 @@ Tcl_FSFileAttrsSet(
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
- if (proc != NULL) {
- return (*proc)(interp, index, pathPtr, objPtr);
- }
+ if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) {
+ return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -2465,55 +2461,55 @@ Tcl_FSGetCwd(
* indicates the particular function has succeeded.
*/
- fsRecPtr = FsGetFirstFilesystem();
- while ((retVal == NULL) && (fsRecPtr != NULL)) {
- Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
- if (proc != NULL) {
- if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
- ClientData retCd;
- TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
-
- retCd = (*proc2)(NULL);
- if (retCd != NULL) {
- Tcl_Obj *norm;
- /* Looks like a new current directory */
- retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(
- retCd);
- Tcl_IncrRefCount(retVal);
- norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL);
- if (norm != NULL) {
- /*
- * We found a cwd, which is now in our global
- * storage. We must make a copy. Norm already has
- * a refCount of 1.
- *
- * Threading issue: note that multiple threads at
- * system startup could in principle call this
- * function simultaneously. They will therefore
- * each set the cwdPathPtr independently. That
- * behaviour is a bit peculiar, but should be
- * fine. Once we have a cwd, we'll always be in
- * the 'else' branch below which is simpler.
- */
-
- FsUpdateCwd(norm, retCd);
- Tcl_DecrRefCount(norm);
- } else {
- (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
- }
- Tcl_DecrRefCount(retVal);
- retVal = NULL;
- goto cdDidNotChange;
- } else if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
- }
+ for (fsRecPtr = FsGetFirstFilesystem();
+ (retVal == NULL) && (fsRecPtr != NULL);
+ fsRecPtr = fsRecPtr->nextPtr) {
+ ClientData retCd;
+ TclFSGetCwdProc2 *proc2;
+ if (fsRecPtr->fsPtr->getCwdProc == NULL) {
+ continue;
+ }
+
+ if (fsRecPtr->fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
+ retVal = fsRecPtr->fsPtr->getCwdProc(interp);
+ continue;
+ }
+
+ proc2 = (TclFSGetCwdProc2 *) fsRecPtr->fsPtr->getCwdProc;
+ retCd = proc2(NULL);
+ if (retCd != NULL) {
+ Tcl_Obj *norm;
+
+ /* Looks like a new current directory */
+ retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(retCd);
+ Tcl_IncrRefCount(retVal);
+ norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL);
+ if (norm != NULL) {
+ /*
+ * We found a cwd, which is now in our global storage. We
+ * must make a copy. Norm already has a refCount of 1.
+ *
+ * Threading issue: note that multiple threads at system
+ * startup could in principle call this function
+ * simultaneously. They will therefore each set the
+ * cwdPathPtr independently. That behaviour is a bit
+ * peculiar, but should be fine. Once we have a cwd, we'll
+ * always be in the 'else' branch below which is simpler.
+ */
+
+ FsUpdateCwd(norm, retCd);
+ Tcl_DecrRefCount(norm);
} else {
- retVal = (*proc)(interp);
+ (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
}
+ Tcl_DecrRefCount(retVal);
+ retVal = NULL;
+ goto cdDidNotChange;
+ } else if (interp != NULL) {
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ Tcl_PosixError(interp), NULL);
}
- fsRecPtr = fsRecPtr->nextPtr;
}
/*
@@ -2527,6 +2523,7 @@ Tcl_FSGetCwd(
if (retVal != NULL) {
Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+
if (norm != NULL) {
/*
* We found a cwd, which is now in our global storage. We must
@@ -2541,6 +2538,7 @@ Tcl_FSGetCwd(
*/
ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
+
FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
Tcl_DecrRefCount(norm);
}
@@ -2554,7 +2552,10 @@ Tcl_FSGetCwd(
* the permissions on that directory have changed.
*/
- const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+ const Tcl_Filesystem *fsPtr =
+ Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+ ClientData retCd = NULL;
+ Tcl_Obj *retVal, *norm;
/*
* If the filesystem couldn't be found, or if no cwd function exists
@@ -2565,94 +2566,98 @@ Tcl_FSGetCwd(
* (This is tested for in the test suite on unix).
*/
- if (fsPtr != NULL) {
- Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
- ClientData retCd = NULL;
- if (proc != NULL) {
- Tcl_Obj *retVal;
- if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
- TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
-
- retCd = (*proc2)(tsdPtr->cwdClientData);
- if (retCd == NULL && interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
- }
+ if (fsPtr == NULL || fsPtr->getCwdProc == NULL) {
+ goto cdDidNotChange;
+ }
- if (retCd == tsdPtr->cwdClientData) {
- goto cdDidNotChange;
- }
+ if (fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
+ retVal = fsPtr->getCwdProc(interp);
+ } else {
+ /*
+ * New API.
+ */
- /*
- * Looks like a new current directory.
- */
+ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
- retVal = (*fsPtr->internalToNormalizedProc)(retCd);
- Tcl_IncrRefCount(retVal);
- } else {
- retVal = (*proc)(interp);
- }
- if (retVal != NULL) {
- Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp,
- retVal, NULL);
+ retCd = proc2(tsdPtr->cwdClientData);
+ if (retCd == NULL && interp != NULL) {
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ Tcl_PosixError(interp), NULL);
+ }
- /*
- * Check whether cwd has changed from the value previously
- * stored in cwdPathPtr. Really 'norm' shouldn't be NULL,
- * but we are careful.
- */
+ if (retCd == tsdPtr->cwdClientData) {
+ goto cdDidNotChange;
+ }
- if (norm == NULL) {
- /* Do nothing */
- if (retCd != NULL) {
- (*fsPtr->freeInternalRepProc)(retCd);
- }
- } else if (norm == tsdPtr->cwdPathPtr) {
- goto cdEqual;
- } else {
- /*
- * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are
- * normalized paths. Therefore we can be more
- * efficient than calling 'Tcl_FSEqualPaths', and in
- * addition avoid a nasty infinite loop bug when
- * trying to normalize tsdPtr->cwdPathPtr.
- */
+ /*
+ * Looks like a new current directory.
+ */
- int len1, len2;
- char *str1, *str2;
-
- str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
- str2 = Tcl_GetStringFromObj(norm, &len2);
- if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
- /*
- * If the paths were equal, we can be more
- * efficient and retain the old path object which
- * will probably already be shared. In this case
- * we can simply free the normalized path we just
- * calculated.
- */
-
- cdEqual:
- Tcl_DecrRefCount(norm);
- if (retCd != NULL) {
- (*fsPtr->freeInternalRepProc)(retCd);
- }
- } else {
- FsUpdateCwd(norm, retCd);
- Tcl_DecrRefCount(norm);
- }
- }
- Tcl_DecrRefCount(retVal);
- } else {
- /*
- * The 'cwd' function returned an error; reset the cwd.
- */
+ retVal = fsPtr->internalToNormalizedProc(retCd);
+ Tcl_IncrRefCount(retVal);
+ }
- FsUpdateCwd(NULL, NULL);
+ /*
+ * Check if the 'cwd' function returned an error; if so, reset the
+ * cwd.
+ */
+
+ if (retVal == NULL) {
+ FsUpdateCwd(NULL, NULL);
+ goto cdDidNotChange;
+ }
+
+ /*
+ * Normalize the path.
+ */
+
+ norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+
+ /*
+ * Check whether cwd has changed from the value previously stored in
+ * cwdPathPtr. Really 'norm' shouldn't be NULL, but we are careful.
+ */
+
+ if (norm == NULL) {
+ /* Do nothing */
+ if (retCd != NULL) {
+ fsPtr->freeInternalRepProc(retCd);
+ }
+ } else if (norm == tsdPtr->cwdPathPtr) {
+ goto cdEqual;
+ } else {
+ /*
+ * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are normalized
+ * paths. Therefore we can be more efficient than calling
+ * 'Tcl_FSEqualPaths', and in addition avoid a nasty infinite loop
+ * bug when trying to normalize tsdPtr->cwdPathPtr.
+ */
+
+ int len1, len2;
+ char *str1, *str2;
+
+ str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
+ str2 = Tcl_GetStringFromObj(norm, &len2);
+ if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
+ /*
+ * If the paths were equal, we can be more efficient and
+ * retain the old path object which will probably already be
+ * shared. In this case we can simply free the normalized path
+ * we just calculated.
+ */
+
+ cdEqual:
+ Tcl_DecrRefCount(norm);
+ if (retCd != NULL) {
+ fsPtr->freeInternalRepProc(retCd);
}
+ } else {
+ FsUpdateCwd(norm, retCd);
+ Tcl_DecrRefCount(norm);
}
}
+ Tcl_DecrRefCount(retVal);
}
cdDidNotChange:
@@ -2697,14 +2702,13 @@ Tcl_FSChdir(
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
- Tcl_FSChdirProc *proc = fsPtr->chdirProc;
- if (proc != NULL) {
+ if (fsPtr->chdirProc != NULL) {
/*
* If this fails, an appropriate errno will have been stored using
* 'Tcl_SetErrno()'.
*/
- retVal = (*proc)(pathPtr);
+ retVal = fsPtr->chdirProc(pathPtr);
} else {
/*
* Fallback on stat-based implementation.
@@ -2738,9 +2742,7 @@ Tcl_FSChdir(
* was no error we must assume that the cwd was actually changed to the
* normalized value we calculated above, and we must therefore cache that
* information.
- */
-
- /*
+ *
* If the filesystem in question has a getCwdProc, then the correct logic
* which performs the part below is already part of the Tcl_FSGetCwd()
* call, so no need to replicate it again. This will have a side effect
@@ -2800,8 +2802,9 @@ Tcl_FSChdir(
* Assumption we are using a filesystem version 2.
*/
- TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
- cd = (*proc2)(oldcd);
+ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
+
+ cd = proc2(oldcd);
if (cd != oldcd) {
FsUpdateCwd(normDirName, cd);
}
@@ -2892,7 +2895,7 @@ Tcl_FSLoadFile(
* Tcl_FSLoadFileProc are both misleading.
*/
- *handlePtr = (Tcl_LoadHandle) clientData;
+ *handlePtr = clientData;
return res;
}
@@ -2954,7 +2957,6 @@ TclLoadFile(
* file. */
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- Tcl_FSLoadFileProc *proc;
Tcl_Filesystem *copyFsPtr;
Tcl_Obj *copyToPtr;
Tcl_LoadHandle newLoadHandle = NULL;
@@ -2968,9 +2970,10 @@ TclLoadFile(
return TCL_ERROR;
}
- proc = fsPtr->loadFileProc;
- if (proc != NULL) {
- int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
+ if (fsPtr->loadFileProc != NULL) {
+ int retVal = fsPtr->loadFileProc(interp, pathPtr, handlePtr,
+ unloadProcPtr);
+
if (retVal == TCL_OK) {
if (*handlePtr == NULL) {
return TCL_ERROR;
@@ -2980,7 +2983,7 @@ TclLoadFile(
* Copy this across, since both are equal for the native fs.
*/
- *clientDataPtr = (ClientData)*handlePtr;
+ *clientDataPtr = *handlePtr;
Tcl_ResetResult(interp);
goto resolveSymbols;
}
@@ -3042,7 +3045,7 @@ TclLoadFile(
ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
unloadProcPtr);
if (ret == TCL_OK && *handlePtr != NULL) {
- *clientDataPtr = (ClientData) *handlePtr;
+ *clientDataPtr = *handlePtr;
goto resolveSymbols;
}
}
@@ -3143,9 +3146,9 @@ TclLoadFile(
* handle and unload proc ptr.
*/
- (*handlePtr) = newLoadHandle;
- (*clientDataPtr) = newClientData;
- (*unloadProcPtr) = newUnloadProcPtr;
+ *handlePtr = newLoadHandle;
+ *clientDataPtr = newClientData;
+ *unloadProcPtr = newUnloadProcPtr;
Tcl_ResetResult(interp);
return TCL_OK;
}
@@ -3200,9 +3203,9 @@ TclLoadFile(
}
copyToPtr = NULL;
- (*handlePtr) = newLoadHandle;
- (*clientDataPtr) = (ClientData) tvdlPtr;
- (*unloadProcPtr) = &FSUnloadTempFile;
+ *handlePtr = newLoadHandle;
+ *clientDataPtr = tvdlPtr;
+ *unloadProcPtr = &FSUnloadTempFile;
Tcl_ResetResult(interp);
return retVal;
@@ -3256,7 +3259,7 @@ TclpLoadFile(
return TCL_ERROR;
}
- *clientDataPtr = (ClientData) handle;
+ *clientDataPtr = handle;
*proc1Ptr = TclpFindSymbol(interp, handle, sym1);
*proc2Ptr = TclpFindSymbol(interp, handle, sym2);
@@ -3319,7 +3322,6 @@ FSUnloadTempFile(
TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
-
} else {
/*
* Remove the temporary file we created. Note, we may crash here
@@ -3354,7 +3356,7 @@ FSUnloadTempFile(
Tcl_DecrRefCount(tvdlPtr->divertedFile);
}
- ckfree((char*)tvdlPtr);
+ ckfree((char *) tvdlPtr);
}
/*
@@ -3398,12 +3400,8 @@ Tcl_FSLink(
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSLinkProc *proc = fsPtr->linkProc;
-
- if (proc != NULL) {
- return (*proc)(pathPtr, toPtr, linkAction);
- }
+ if (fsPtr != NULL && fsPtr->linkProc != NULL) {
+ return fsPtr->linkProc(pathPtr, toPtr, linkAction);
}
/*
@@ -3415,7 +3413,7 @@ Tcl_FSLink(
*/
#ifndef S_IFLNK
- errno = EINVAL;
+ errno = EINVAL; /* TODO: Change to Tcl_SetErrno()? */
#else
Tcl_SetErrno(ENOENT);
#endif /* S_IFLNK */
@@ -3447,7 +3445,7 @@ Tcl_FSLink(
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
+Tcl_Obj *
Tcl_FSListVolumes(void)
{
FilesystemRecord *fsRecPtr;
@@ -3462,9 +3460,9 @@ Tcl_FSListVolumes(void)
fsRecPtr = FsGetFirstFilesystem();
while (fsRecPtr != NULL) {
- Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
- if (proc != NULL) {
- Tcl_Obj *thisFsVolumes = (*proc)();
+ if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
+ Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
+
if (thisFsVolumes != NULL) {
Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
Tcl_DecrRefCount(thisFsVolumes);
@@ -3512,15 +3510,13 @@ FsListMounts(
fsRecPtr = FsGetFirstFilesystem();
while (fsRecPtr != NULL) {
- if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
- Tcl_FSMatchInDirectoryProc *proc =
- fsRecPtr->fsPtr->matchInDirectoryProc;
- if (proc != NULL) {
- if (resultPtr == NULL) {
- resultPtr = Tcl_NewObj();
- }
- (*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
+ if (fsRecPtr->fsPtr != &tclNativeFilesystem &&
+ fsRecPtr->fsPtr->matchInDirectoryProc != NULL) {
+ if (resultPtr == NULL) {
+ resultPtr = Tcl_NewObj();
}
+ fsRecPtr->fsPtr->matchInDirectoryProc(NULL, resultPtr, pathPtr,
+ pattern, &mountsOnly);
}
fsRecPtr = fsRecPtr->nextPtr;
}
@@ -3578,6 +3574,7 @@ Tcl_FSSplitPath(
if (fsPtr->filesystemSeparatorProc != NULL) {
Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);
+
if (sep != NULL) {
Tcl_IncrRefCount(sep);
separator = Tcl_GetString(sep)[0];
@@ -3604,12 +3601,14 @@ Tcl_FSSplitPath(
for (;;) {
char *elementStart = p;
int length;
+
while ((*p != '\0') && (*p != separator)) {
p++;
}
length = p - elementStart;
if (length > 0) {
Tcl_Obj *nextElt;
+
if (elementStart[0] == '~') {
TclNewLiteralStringObj(nextElt, "./");
Tcl_AppendToObj(nextElt, elementStart, length);
@@ -3650,12 +3649,11 @@ TclFSInternalToNormalized(
fsRecPtr = fsRecPtr->nextPtr;
}
- if ((fsRecPtr != NULL)
- && (fromFilesystem->internalToNormalizedProc != NULL)) {
- return (*fromFilesystem->internalToNormalizedProc)(clientData);
- } else {
+ if ((fsRecPtr == NULL)
+ || (fromFilesystem->internalToNormalizedProc == NULL)) {
return NULL;
}
+ return (*fromFilesystem->internalToNormalizedProc)(clientData);
}
/*
@@ -3694,11 +3692,9 @@ TclGetPathType(
* caller. */
{
int pathLen;
- char *path;
+ char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
Tcl_PathType type;
- path = Tcl_GetStringFromObj(pathPtr, &pathLen);
-
type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
driveNameLengthPtr, driveNameRef);
@@ -3762,17 +3758,15 @@ TclFSNonnativePathType(
fsRecPtr = FsGetFirstFilesystem();
while (fsRecPtr != NULL) {
- Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
-
/*
* 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 (*proc) 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.
+ * 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
@@ -3783,18 +3777,19 @@ TclFSNonnativePathType(
* better.
*/
- if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
+ if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
+ && (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
int numVolumes;
- Tcl_Obj *thisFsVolumes = (*proc)();
+ Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
if (thisFsVolumes != NULL) {
if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
!= TCL_OK) {
/*
- * This is VERY bad; the Tcl_FSListVolumesProc didn't
- * return a valid list. Set numVolumes to -1 so that we
- * skip the while loop below and just return with the
- * current value of 'type'.
+ * This is VERY bad; the listVolumesProc didn't return a
+ * valid list. Set numVolumes to -1 so that we skip the
+ * while loop below and just return with the current value
+ * of 'type'.
*
* It would be better if we could signal an error here
* (but Tcl_Panic seems a bit excessive).
@@ -3833,6 +3828,7 @@ TclFSNonnativePathType(
/*
* We don't need to examine any more filesystems.
*/
+
break;
}
}
@@ -3862,21 +3858,20 @@ TclFSNonnativePathType(
int
Tcl_FSRenameFile(
- Tcl_Obj* srcPathPtr, /* Pathname of file or dir to be renamed
+ Tcl_Obj *srcPathPtr, /* Pathname of file or dir to be renamed
* (UTF-8). */
Tcl_Obj *destPathPtr) /* New pathname of file or directory
* (UTF-8). */
{
int retVal = -1;
const Tcl_Filesystem *fsPtr, *fsPtr2;
+
fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
- if ((fsPtr == fsPtr2) && (fsPtr != NULL)) {
- Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
- if (proc != NULL) {
- retVal = (*proc)(srcPathPtr, destPathPtr);
- }
+ if ((fsPtr == fsPtr2) && (fsPtr != NULL)
+ && (fsPtr->renameFileProc != NULL)) {
+ retVal = fsPtr->renameFileProc(srcPathPtr, destPathPtr);
}
if (retVal == -1) {
Tcl_SetErrno(EXDEV);
@@ -3913,14 +3908,12 @@ Tcl_FSCopyFile(
{
int retVal = -1;
const Tcl_Filesystem *fsPtr, *fsPtr2;
+
fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
- if (fsPtr == fsPtr2 && fsPtr != NULL) {
- Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
- if (proc != NULL) {
- retVal = (*proc)(srcPathPtr, destPathPtr);
- }
+ if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyFileProc != NULL) {
+ retVal = fsPtr->copyFileProc(srcPathPtr, destPathPtr);
}
if (retVal == -1) {
Tcl_SetErrno(EXDEV);
@@ -3945,6 +3938,7 @@ Tcl_FSCopyFile(
*
*---------------------------------------------------------------------------
*/
+
int
TclCrossFilesystemCopy(
Tcl_Interp *interp, /* For error messages */
@@ -4027,11 +4021,9 @@ Tcl_FSDeleteFile(
Tcl_Obj *pathPtr) /* Pathname of file to be removed (UTF-8). */
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
- if (proc != NULL) {
- return (*proc)(pathPtr);
- }
+
+ if (fsPtr != NULL && fsPtr->deleteFileProc != NULL) {
+ return fsPtr->deleteFileProc(pathPtr);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -4059,11 +4051,9 @@ Tcl_FSCreateDirectory(
Tcl_Obj *pathPtr) /* Pathname of directory to create (UTF-8). */
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
- if (proc != NULL) {
- return (*proc)(pathPtr);
- }
+
+ if (fsPtr != NULL && fsPtr->createDirectoryProc != NULL) {
+ return fsPtr->createDirectoryProc(pathPtr);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -4089,7 +4079,7 @@ Tcl_FSCreateDirectory(
int
Tcl_FSCopyDirectory(
- Tcl_Obj* srcPathPtr, /* Pathname of directory to be copied
+ Tcl_Obj *srcPathPtr, /* Pathname of directory to be copied
* (UTF-8). */
Tcl_Obj *destPathPtr, /* Pathname of target directory (UTF-8). */
Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new
@@ -4098,14 +4088,12 @@ Tcl_FSCopyDirectory(
{
int retVal = -1;
const Tcl_Filesystem *fsPtr, *fsPtr2;
+
fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
- if (fsPtr == fsPtr2 && fsPtr != NULL) {
- Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
- if (proc != NULL) {
- retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
- }
+ if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyDirectoryProc != NULL){
+ retVal = fsPtr->copyDirectoryProc(srcPathPtr, destPathPtr, errorPtr);
}
if (retVal == -1) {
Tcl_SetErrno(EXDEV);
@@ -4142,8 +4130,8 @@ Tcl_FSRemoveDirectory(
* error, with refCount 1. */
{
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
if (fsPtr != NULL && fsPtr->removeDirectoryProc != NULL) {
- Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
if (recursive) {
/*
* We check whether the cwd lies inside this directory and move it
@@ -4177,7 +4165,7 @@ Tcl_FSRemoveDirectory(
Tcl_DecrRefCount(cwdPtr);
}
}
- return (*proc)(pathPtr, recursive, errorPtr);
+ return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -4204,10 +4192,10 @@ Tcl_FSRemoveDirectory(
Tcl_Filesystem *
Tcl_FSGetFileSystemForPath(
- Tcl_Obj* pathPtr)
+ Tcl_Obj *pathPtr)
{
FilesystemRecord *fsRecPtr;
- Tcl_Filesystem* retVal = NULL;
+ Tcl_Filesystem *retVal = NULL;
if (pathPtr == NULL) {
Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
@@ -4233,9 +4221,11 @@ Tcl_FSGetFileSystemForPath(
*/
fsRecPtr = FsGetFirstFilesystem();
-
if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
return NULL;
+ } else if (retVal != NULL) {
+ /* TODO: Can this happen? */
+ return retVal;
}
/*
@@ -4243,26 +4233,25 @@ Tcl_FSGetFileSystemForPath(
* non-return value of -1 indicates the particular function has succeeded.
*/
- while ((retVal == NULL) && (fsRecPtr != NULL)) {
- Tcl_FSPathInFilesystemProc *proc =
- fsRecPtr->fsPtr->pathInFilesystemProc;
+ for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) {
+ ClientData clientData = NULL;
- if (proc != NULL) {
- ClientData clientData = NULL;
- if ((*proc)(pathPtr, &clientData) != -1) {
- /*
- * We assume the type of pathPtr hasn't been changed by the
- * above call to the pathInFilesystemProc.
- */
+ if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) {
+ continue;
+ }
- TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
- retVal = fsRecPtr->fsPtr;
- }
+ if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, &clientData)!=-1) {
+ /*
+ * We assume the type of pathPtr hasn't been changed by the above
+ * call to the pathInFilesystemProc.
+ */
+
+ TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
+ return fsRecPtr->fsPtr;
}
- fsRecPtr = fsRecPtr->nextPtr;
}
- return retVal;
+ return NULL;
}
/*
@@ -4347,7 +4336,6 @@ Tcl_FSFileSystemInfo(
Tcl_Obj *pathPtr)
{
Tcl_Obj *resPtr;
- Tcl_FSFilesystemPathTypeProc *proc;
const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr == NULL) {
@@ -4355,11 +4343,12 @@ Tcl_FSFileSystemInfo(
}
resPtr = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(NULL,resPtr,Tcl_NewStringObj(fsPtr->typeName,-1));
+ Tcl_ListObjAppendElement(NULL, resPtr,
+ Tcl_NewStringObj(fsPtr->typeName, -1));
+
+ if (fsPtr->filesystemPathTypeProc != NULL) {
+ Tcl_Obj *typePtr = fsPtr->filesystemPathTypeProc(pathPtr);
- proc = fsPtr->filesystemPathTypeProc;
- if (proc != NULL) {
- Tcl_Obj *typePtr = (*proc)(pathPtr);
if (typePtr != NULL) {
Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f2a125b..2c50d21 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.365 2008/04/16 14:49:29 das Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.366 2008/05/02 10:27:07 dkf Exp $
*/
#ifndef _TCLINT
@@ -2269,10 +2269,10 @@ typedef enum Tcl_PathPart {
*----------------------------------------------------------------
*/
-typedef int (TclStatProc_) (CONST char *path, struct stat *buf);
-typedef int (TclAccessProc_) (CONST char *path, int mode);
+typedef int (TclStatProc_) (const char *path, struct stat *buf);
+typedef int (TclAccessProc_) (const char *path, int mode);
typedef Tcl_Channel (TclOpenFileChannelProc_) (Tcl_Interp *interp,
- CONST char *fileName, CONST char *modeString, int permissions);
+ const char *fileName, const char *modeString, int permissions);
/*
*----------------------------------------------------------------
diff --git a/generic/tclRegexp.h b/generic/tclRegexp.h
index af5a9ae..bd26b85 100644
--- a/generic/tclRegexp.h
+++ b/generic/tclRegexp.h
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclRegexp.h,v 1.15 2007/12/13 15:23:20 dgp Exp $
+ * RCS: @(#) $Id: tclRegexp.h,v 1.16 2008/05/02 10:27:08 dkf Exp $
*/
#ifndef _TCLREGEXP
@@ -30,7 +30,7 @@ typedef struct TclRegexp {
int flags; /* Regexp compile flags. */
regex_t re; /* Compiled re, includes number of
* subexpressions. */
- CONST char *string; /* Last string passed to Tcl_RegExpExec. */
+ const char *string; /* Last string passed to Tcl_RegExpExec. */
Tcl_Obj *objPtr; /* Last object passed to Tcl_RegExpExecObj. */
Tcl_Obj *globObjPtr; /* Glob pattern rep of RE or NULL if none. */
regmatch_t *matches; /* Array of indices into the Tcl_UniChar
generated by cgit v0.12 at 2024-11-19 18:52:31 (GMT)