Attachment "tclload.patch" to
ticket [453512ffff]
added by
vincentdarley
2001-09-04 00:46:37.
? tests/tmp
? win/outdata
? win/testfile
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.558
diff -u -r1.558 ChangeLog
--- ChangeLog 2001/09/03 09:38:50 1.558
+++ ChangeLog 2001/09/03 17:45:21
@@ -3,6 +3,29 @@
* doc/ExprLongObj.3: Fixed error in documentation of argument type
to Tcl_ExprObj [Bug: 457435]
+2001-08-30 Vince Darley <[email protected]>
+
+ Minor bug fixes in filesystem.
+ * tests/fileName.test: ensure new test cleans up after itself
+ * generic/tclFileName.c: improved Mac path handling and fix
+ [Bug: 421842] on Windows handling of UNC paths.
+ * unix/tclUnixPipe.c:
+ * generic/tclFCmd.c:
+ * generic/tclIOUtil.c: fixed error message, fixed [Bug: ]
+ about dangerous use of tmpnam, best way to fix it involved
+ changes so Tcl_FSCopyFile now falls back on cross-filesystem
+ copy (this only previously occurred at the Tcl level), which
+ avoids code duplication.
+ * generic/tclTest.c: made test vfs fully functional as a
+ 'reporting filesystem'.
+ * generic/tcl.h:
+ * generic/tclInt.h:
+ * generic/tclIOUtil.c: fixed comments about unload behaviour,
+ and completed objectification of loading. Required change
+ to Tcl_Filesystem lookup table, so incompatible with 8.4a3, but
+ not older versions of Tcl. The change also allows 'link' and
+ 'reporting' filesystems to function correctly when loading files.
+
2001-09-02 David Gravereaux <[email protected]>
* win/tclWinThrd.c: Portability fix for Cygwin who's c-runtime,
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.53
diff -u -r1.53 tcl.decls
--- generic/tcl.decls 2001/08/30 08:53:14 1.53
+++ generic/tcl.decls 2001/09/03 17:45:21
@@ -1667,6 +1667,9 @@
declare 476 generic {
char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
}
+declare 477 generic {
+ Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathObjPtr)
+}
##############################################################################
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.97
diff -u -r1.97 tcl.h
--- generic/tcl.h 2001/08/30 15:41:29 1.97
+++ generic/tcl.h 2001/09/03 17:45:22
@@ -1554,7 +1554,8 @@
Tcl_Obj *pathPtr, char * sym1, char * sym2,
Tcl_PackageInitProc ** proc1Ptr,
Tcl_PackageInitProc ** proc2Ptr,
- ClientData * clientDataPtr));
+ ClientData * clientDataPtr,
+ Tcl_FSUnloadFileProc **unloadProcPtr));
typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
ClientData *clientDataPtr));
typedef Tcl_Obj* (Tcl_FSFilesystemPathTypeProc)
@@ -1739,12 +1740,6 @@
* implemented, Tcl will fall back on
* a copy to native-temp followed by a
* Tcl_FSLoadFile on that temporary copy. */
- Tcl_FSUnloadFileProc *unloadFileProc;
- /* Function to unload a previously
- * successfully loaded file. If load was
- * implemented, then this should also be
- * implemented, if there is any cleanup
- * action required. */
Tcl_FSGetCwdProc *getCwdProc;
/*
* Function to process a 'Tcl_FSGetCwd()'
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.54
diff -u -r1.54 tclDecls.h
--- generic/tclDecls.h 2001/08/23 17:37:07 1.54
+++ generic/tclDecls.h 2001/09/03 17:45:22
@@ -1490,6 +1490,9 @@
/* 476 */
EXTERN char* Tcl_FSGetTranslatedStringPath _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj* pathPtr));
+/* 477 */
+EXTERN Tcl_Filesystem* Tcl_FSGetFileSystemForPath _ANSI_ARGS_((
+ Tcl_Obj* pathObjPtr));
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -2026,6 +2029,7 @@
int (*tcl_FSUnregister) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 474 */
ClientData (*tcl_FSData) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 475 */
char* (*tcl_FSGetTranslatedStringPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 476 */
+ Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 477 */
} TclStubs;
#ifdef __cplusplus
@@ -3973,6 +3977,10 @@
#ifndef Tcl_FSGetTranslatedStringPath
#define Tcl_FSGetTranslatedStringPath \
(tclStubsPtr->tcl_FSGetTranslatedStringPath) /* 476 */
+#endif
+#ifndef Tcl_FSGetFileSystemForPath
+#define Tcl_FSGetFileSystemForPath \
+ (tclStubsPtr->tcl_FSGetFileSystemForPath) /* 477 */
#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.28
diff -u -r1.28 tclExecute.c
--- generic/tclExecute.c 2001/09/01 00:51:31 1.28
+++ generic/tclExecute.c 2001/09/03 17:45:23
@@ -1430,7 +1430,7 @@
}
PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("%u => " opnd), valuePtr);
+ TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
ADJUST_PC(5);
/*
Index: generic/tclFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFCmd.c,v
retrieving revision 1.11
diff -u -r1.11 tclFCmd.c
--- generic/tclFCmd.c 2001/08/30 08:53:14 1.11
+++ generic/tclFCmd.c 2001/09/03 17:45:23
@@ -599,53 +599,13 @@
}
} else {
result = Tcl_FSCopyFile(source, target);
- if ((result != TCL_OK) && (errno == EXDEV)) {
- /*
- * Well, there really shouldn't be a problem with source,
- * because up there we checked to see if it was ok to copy it.
- *
- * Either there is a problem with target, or we're trying
- * to do a cross-filesystem copy. We open the target for
- * writing to decide between those two cases.
+ if (result != TCL_OK) {
+ /*
+ * We could examine 'errno' to double-check if the problem
+ * was with the target, but we checked the source above,
+ * so it should be quite clear
*/
- int prot = 0666;
- Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
- if (out == NULL) {
- /* There was a problem with the target */
- errfile = target;
- } else {
- /* It looks like we can copy it over */
- Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source,
- "r", prot);
- if (in == NULL) {
- /* This is very strange, we checked this above */
- Tcl_Close(interp, out);
- errfile = source;
- } else {
- struct utimbuf tval;
- /*
- * Copy it synchronously. We might wish to add an
- * asynchronous option to support vfs's which are
- * slow (e.g. network sockets).
- */
- Tcl_SetChannelOption(interp, in, "-translation", "binary");
- Tcl_SetChannelOption(interp, out, "-translation", "binary");
-
- if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
- result = TCL_OK;
- }
- /*
- * If the copy failed, assume that copy channel left
- * a good error message.
- */
- Tcl_Close(interp, in);
- Tcl_Close(interp, out);
- /* Set modification date of copied file */
- tval.actime = sourceStatBuf.st_atime;
- tval.modtime = sourceStatBuf.st_mtime;
- Tcl_FSUtime(source, &tval);
- }
- }
+ errfile = target;
}
}
if ((copyFlag == 0) && (result == TCL_OK)) {
Index: generic/tclFileName.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFileName.c,v
retrieving revision 1.19
diff -u -r1.19 tclFileName.c
--- generic/tclFileName.c 2001/08/30 08:53:14 1.19
+++ generic/tclFileName.c 2001/09/03 17:45:23
@@ -17,18 +17,10 @@
#include "tclPort.h"
#include "tclRegexp.h"
-/*
- * The following regular expression matches the root portion of a Windows
- * absolute or volume relative path. It will match both UNC and drive relative
- * paths. This pattern is no longer used, since it has been replaced by
- * the ExtractWinRoot function.
- */
-
-#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*"
-
/*
* This define is used to activate Tcl's interpretation of Unix-style
- * paths (containing forward slashes) on MacOS.
+ * paths (containing forward slashes, '.' and '..') on MacOS. A
+ * side-effect of this is that some paths become ambiguous.
*/
#define MAC_UNDERSTANDS_UNIX_PATHS
@@ -36,19 +28,19 @@
/*
* The following regular expression matches the root portion of a Macintosh
* absolute path. It will match degenerate Unix-style paths, tilde paths,
- * Unix-style paths, and Mac paths.
- */
-
-#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
-#else
-/*
- * The following regular expression and some code below needs to be updated
- * to allow complete removal of unix-style path matching. For the moment
- * this regular expression is the same as the one above.
+ * Unix-style paths, and Mac paths. The various subexpressions in this
+ * can be summarised as follows: ^(/..|~user/unix|~user:mac|/unix|mac:dir).
+ * The subexpression indices which match the root portions, are as follows:
+ *
+ * degenerate unix-style: 2
+ * unix-tilde: 5
+ * mac-tilde: 7
+ * unix-style: 9 (or 10 to cut off the irrelevant header).
+ * mac: 12
+ *
*/
#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
-#endif
/*
* The following variables are used to hold precompiled regular expressions
@@ -62,6 +54,11 @@
static Tcl_ThreadDataKey dataKey;
+static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
+static void FileNameInit _ANSI_ARGS_((void));
+
+#endif
+
/*
* The following variable is set in the TclPlatformInit call to one
* of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
@@ -78,13 +75,12 @@
static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path,
Tcl_DString *resultPtr, int offset,
Tcl_PathType *typePtr));
-static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
-static void FileNameInit _ANSI_ARGS_((void));
static int SkipToChar _ANSI_ARGS_((char **stringPtr,
char *match));
static Tcl_Obj* SplitMacPath _ANSI_ARGS_((CONST char *path));
static Tcl_Obj* SplitWinPath _ANSI_ARGS_((CONST char *path));
static Tcl_Obj* SplitUnixPath _ANSI_ARGS_((CONST char *path));
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
/*
*----------------------------------------------------------------------
@@ -138,6 +134,7 @@
Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
tsdPtr->initialized = 0;
}
+#endif
/*
*----------------------------------------------------------------------
@@ -167,8 +164,6 @@
* stored. */
Tcl_PathType *typePtr; /* Where to store pathType result */
{
- FileNameInit();
-
if (path[0] == '/' || path[0] == '\\') {
/* Might be a UNC or Vol-Relative path */
char *host, *share, *tail;
@@ -192,11 +187,18 @@
/*
* The path given is simply of the form
* '/foo', '//foo', '/////foo' or the same
- * with backslashes.
+ * with backslashes. If there is exactly
+ * one leading '/' the path is volume relative
+ * (see filename man page). If there are more
+ * than one the path is UNC and absolute.
*/
- *typePtr = TCL_PATH_VOLUME_RELATIVE;
- Tcl_DStringAppend(resultPtr, "/", 1);
- return &path[2];
+ if (0 && (path[1] == '/' || path[1] == '\\')) {
+ /* just continue */
+ } else {
+ *typePtr = TCL_PATH_VOLUME_RELATIVE;
+ Tcl_DStringAppend(resultPtr, "/", 1);
+ return &path[2];
+ }
}
Tcl_DStringSetLength(resultPtr, offset);
share = &host[hlen];
@@ -362,6 +364,7 @@
if (path[0] == ':') {
type = TCL_PATH_RELATIVE;
} else {
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
ThreadSpecificData *tsdPtr;
Tcl_RegExp re;
@@ -380,7 +383,6 @@
type = TCL_PATH_RELATIVE;
} else {
char *root, *end;
-
Tcl_RegExpRange(re, 2, &root, &end);
if (root != NULL) {
type = TCL_PATH_RELATIVE;
@@ -389,7 +391,6 @@
Tcl_RegExpRange(re, 0, &root, &end);
*driveNameLengthPtr = end - root;
}
-#ifdef MAC_UNDERSTANDS_UNIX_PATHS
if (driveNameRef != NULL) {
if (*root == '/') {
char *c;
@@ -416,9 +417,25 @@
}
}
}
-#endif
}
}
+#else
+ if (path[0] == '~') {
+ } else if (path[0] == ':') {
+ type = TCL_PATH_RELATIVE;
+ } else {
+ char *colonPos = strchr(path,':');
+ if (colonPos == NULL) {
+ type = TCL_PATH_RELATIVE;
+ } else {
+ }
+ }
+ if (type == TCL_PATH_ABSOLUTE) {
+ if (driveNameLengthPtr != NULL) {
+ *driveNameLengthPtr = strlen(path);
+ }
+ }
+#endif
}
break;
@@ -762,14 +779,18 @@
CONST char *path; /* Pointer to string containing a path. */
{
int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */
- int i, length;
+ int length;
CONST char *p, *elementStart;
- Tcl_RegExp re;
Tcl_Obj *result;
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+ Tcl_RegExp re;
+ int i;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
+#endif
+
result = Tcl_NewObj();
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
/*
* Initialize the path name parser for Macintosh path names.
*/
@@ -843,13 +864,11 @@
}
}
}
-
Tcl_RegExpRange(re, i, &start, &end);
length = end - start;
/*
- * Append the element and terminate it with a : and a null. Note that
- * we are forcing the DString to contain an extra null at the end.
+ * Append the element and terminate it with a :
*/
nextElt = Tcl_NewStringObj(start, length);
@@ -860,15 +879,49 @@
isMac = (strchr(path, ':') != NULL);
p = path;
}
+#else
+ if ((path[0] != ':') && (path[0] == '~' || (strchr(path,':') != NULL))) {
+ CONST char *end;
+ Tcl_Obj *nextElt;
+
+ isMac = 1;
+
+ end = strchr(path,':');
+ if (end == NULL) {
+ length = strlen(path);
+ } else {
+ length = end - path;
+ }
+
+ /*
+ * Append the element and terminate it with a :
+ */
+
+ nextElt = Tcl_NewStringObj(path, length);
+ Tcl_AppendToObj(nextElt, ":", 1);
+ Tcl_ListObjAppendElement(NULL, result, nextElt);
+ p = path + length;
+ } else {
+ isMac = (strchr(path, ':') != NULL);
+ isMac = 1;
+ p = path;
+ }
+#endif
if (isMac) {
/*
* p is pointing at the first colon in the path. There
* will always be one, since this is a Mac-style path.
+ * (This is no longer true if MAC_UNDERSTANDS_UNIX_PATHS
+ * is false, so we must check whether 'p' points to the
+ * end of the string.)
*/
-
- elementStart = p++;
+ elementStart = p;
+ if (*p == ':') {
+ p++;
+ }
+
while ((p = strchr(p, ':')) != NULL) {
length = p - elementStart;
if (length == 1) {
@@ -891,13 +944,20 @@
elementStart = p++;
}
}
- if (elementStart[1] != '\0' || elementStart == path) {
- if ((elementStart[1] != '~') && (elementStart[1] != '\0')
- && (strchr(elementStart+1, '/') == NULL)) {
+ if (elementStart[0] != ':') {
+ if (elementStart[0] != '\0') {
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(elementStart, -1));
+ }
+ } else {
+ if (elementStart[1] != '\0' || elementStart == path) {
+ if ((elementStart[1] != '~') && (elementStart[1] != '\0')
+ && (strchr(elementStart+1, '/') == NULL)) {
elementStart++;
+ }
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(elementStart, -1));
}
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(elementStart, -1));
}
} else {
@@ -1150,6 +1210,11 @@
*/
newLength = strlen(p);
+ /*
+ * It may not be good to just do 'Tcl_AppendToObj(prefix,
+ * p, newLength)' because the object may contain duplicate
+ * colons which we want to get rid of.
+ */
Tcl_AppendToObj(prefix, p, newLength);
/* Remove spurious trailing single ':' */
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.17
diff -u -r1.17 tclIOUtil.c
--- generic/tclIOUtil.c 2001/08/30 08:53:14 1.17
+++ generic/tclIOUtil.c 2001/09/03 17:45:23
@@ -41,11 +41,11 @@
static int SetFsPathFromAbsoluteNormalized
_ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
static int FindSplitPos _ANSI_ARGS_((char *path, char *separator));
-static Tcl_Filesystem* Tcl_FSGetFileSystemForPath
- _ANSI_ARGS_((Tcl_Obj* pathObjPtr));
static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
+static int CrossFilesystemCopy _ANSI_ARGS_((Tcl_Obj *source,
+ Tcl_Obj *target));
/*
* Define the 'path' object type, which Tcl uses to represent
@@ -337,7 +337,6 @@
&TclpObjRenameFile,
&TclpObjCopyDirectory,
&TclpLoadFile,
- &TclpUnloadFile,
&TclpObjGetCwd,
&TclpObjChdir
};
@@ -862,7 +861,7 @@
/*
* We could add an efficiency check like this:
*
- * if (retVal == Tcl_DStringLength(pathPtr)) {break;}
+ * if (retVal == length-of(pathPtr)) {break;}
*
* but there's not much benefit.
*/
@@ -1563,7 +1562,7 @@
cwd = Tcl_FSGetCwd(NULL);
if (cwd == NULL) {
if (interp != NULL) {
- Tcl_SetResult(interp, "glob couldn't determine"
+ Tcl_SetResult(interp, "glob couldn't determine "
"the current working directory", TCL_STATIC);
}
return TCL_ERROR;
@@ -2186,19 +2185,15 @@
Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
if (proc != NULL) {
int retVal = (*proc)(interp, pathPtr, sym1, sym2,
- proc1Ptr, proc2Ptr, clientDataPtr);
- if (retVal != -1) {
- /*
- * We handled it. Remember which unload file
- * proc to use.
- */
- (*unloadProcPtr) = fsPtr->unloadFileProc;
- }
+ proc1Ptr, proc2Ptr, clientDataPtr,
+ unloadProcPtr);
return retVal;
} else {
Tcl_Filesystem *copyFsPtr;
- /* Get a temporary filename to use, first to
- * copy the file into, and then to load. */
+ /*
+ * Get a temporary filename to use, first to
+ * copy the file into, and then to load.
+ */
Tcl_Obj *copyToPtr = TclpTempFileName();
if (copyToPtr == NULL) {
return -1;
@@ -2207,14 +2202,16 @@
copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
- /* We already know we can't use Tcl_FSLoadFile from
+ /*
+ * We already know we can't use Tcl_FSLoadFile from
* this filesystem, and we must avoid a possible
- * infinite loop. */
+ * infinite loop.
+ */
Tcl_DecrRefCount(copyToPtr);
return -1;
}
- if (Tcl_FSCopyFile(pathPtr, copyToPtr) == 0) {
+ if (CrossFilesystemCopy(pathPtr, copyToPtr) == TCL_OK) {
/*
* Do we need to set appropriate permissions
* on the file? This may be required on some
@@ -2452,13 +2449,15 @@
int *driveNameLengthPtr;
{
if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
- return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL);
+ return GetPathType(pathObjPtr, filesystemPtrPtr,
+ driveNameLengthPtr, NULL);
} else {
FsPath *fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
if (fsPathPtr->cwdPtr != NULL) {
return TCL_PATH_RELATIVE;
} else {
- return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL);
+ return GetPathType(pathObjPtr, filesystemPtrPtr,
+ driveNameLengthPtr, NULL);
}
}
}
@@ -2817,7 +2816,8 @@
FsReleaseIterator();
if (type != TCL_PATH_ABSOLUTE) {
- type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef);
+ type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr,
+ driveNameRef);
if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
*filesystemPtrPtr = &nativeFilesystem;
}
@@ -2904,12 +2904,80 @@
if (retVal == -1) {
Tcl_SetErrno(EXDEV);
}
+ if ((retVal != TCL_OK) && (errno == EXDEV)) {
+ retVal = CrossFilesystemCopy(srcPathPtr, destPathPtr);
+ }
return retVal;
}
/*
*---------------------------------------------------------------------------
*
+ * CrossFilesystemCopy --
+ *
+ * Helper for above function, and for Tcl_FSLoadFile, to copy
+ * files from one filesystem to another. This function will
+ * overwrite the target file if it already exists.
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * A file may be created.
+ *
+ *---------------------------------------------------------------------------
+ */
+int
+CrossFilesystemCopy(source, target)
+ Tcl_Obj *source; /* Pathname of file to be copied (UTF-8). */
+ Tcl_Obj *target; /* Pathname of file to copy to (UTF-8). */
+{
+ int result = TCL_ERROR;
+ int prot = 0666;
+
+ Tcl_Channel out = Tcl_FSOpenFileChannel(NULL, target, "w", prot);
+ if (out != NULL) {
+ /* It looks like we can copy it over */
+ Tcl_Channel in = Tcl_FSOpenFileChannel(NULL, source,
+ "r", prot);
+ if (in == NULL) {
+ /* This is very strange, we checked this above */
+ Tcl_Close(NULL, out);
+ } else {
+ struct stat sourceStatBuf;
+ struct utimbuf tval;
+ /*
+ * Copy it synchronously. We might wish to add an
+ * asynchronous option to support vfs's which are
+ * slow (e.g. network sockets).
+ */
+ Tcl_SetChannelOption(NULL, in, "-translation", "binary");
+ Tcl_SetChannelOption(NULL, out, "-translation", "binary");
+
+ if (TclCopyChannel(NULL, in, out, -1, NULL) == TCL_OK) {
+ result = TCL_OK;
+ }
+ /*
+ * If the copy failed, assume that copy channel left
+ * a good error message.
+ */
+ Tcl_Close(NULL, in);
+ Tcl_Close(NULL, out);
+
+ /* Set modification date of copied file */
+ if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
+ tval.actime = sourceStatBuf.st_atime;
+ tval.modtime = sourceStatBuf.st_mtime;
+ Tcl_FSUtime(source, &tval);
+ }
+ }
+ }
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* Tcl_FSDeleteFile --
*
* The appropriate function for the filesystem to which pathPtr
@@ -4137,7 +4205,7 @@
*---------------------------------------------------------------------------
*/
-static Tcl_Filesystem*
+Tcl_Filesystem*
Tcl_FSGetFileSystemForPath(pathObjPtr)
Tcl_Obj* pathObjPtr;
{
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.62
diff -u -r1.62 tclInt.h
--- generic/tclInt.h 2001/09/01 00:51:31 1.62
+++ generic/tclInt.h 2001/09/03 17:45:24
@@ -1804,7 +1804,8 @@
Tcl_Obj *pathPtr, char *sym1, char *sym2,
Tcl_PackageInitProc **proc1Ptr,
Tcl_PackageInitProc **proc2Ptr,
- ClientData *clientDataPtr));
+ ClientData *clientDataPtr,
+ Tcl_FSUnloadFileProc **unloadProcPtr));
EXTERN Tcl_Obj* TclpObjListVolumes _ANSI_ARGS_((void));
EXTERN void TclpMasterLock _ANSI_ARGS_((void));
EXTERN void TclpMasterUnlock _ANSI_ARGS_((void));
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.56
diff -u -r1.56 tclStubInit.c
--- generic/tclStubInit.c 2001/08/30 08:53:15 1.56
+++ generic/tclStubInit.c 2001/09/03 17:45:24
@@ -873,6 +873,7 @@
Tcl_FSUnregister, /* 474 */
Tcl_FSData, /* 475 */
Tcl_FSGetTranslatedStringPath, /* 476 */
+ Tcl_FSGetFileSystemForPath, /* 477 */
};
/* !END!: Do not edit above this line. */
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.28
diff -u -r1.28 tclTest.c
--- generic/tclTest.c 2001/08/30 08:53:15 1.28
+++ generic/tclTest.c 2001/09/03 17:45:28
@@ -319,7 +319,6 @@
static Tcl_FSAccessProc TestReportAccess;
static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel;
static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory;
-static Tcl_FSGetCwdProc TestReportGetCwd;
static Tcl_FSChdirProc TestReportChdir;
static Tcl_FSLstatProc TestReportLstat;
static Tcl_FSCopyFileProc TestReportCopyFile;
@@ -331,20 +330,22 @@
static Tcl_FSLoadFileProc TestReportLoadFile;
static Tcl_FSUnloadFileProc TestReportUnloadFile;
static Tcl_FSLinkProc TestReportLink;
-static Tcl_FSListVolumesProc TestReportListVolumes;
static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings;
static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet;
static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet;
static Tcl_FSUtimeProc TestReportUtime;
static Tcl_FSNormalizePathProc TestReportNormalizePath;
+static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
+static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
+static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
static Tcl_Filesystem testReportingFilesystem = {
"reporting",
sizeof(Tcl_Filesystem),
TCL_FILESYSTEM_VERSION_1,
- NULL, /* path in */
- NULL, /* native dup */
- NULL, /* native free */
+ &TestReportInFilesystem, /* path in */
+ &TestReportDupInternalRep,
+ &TestReportFreeInternalRep,
NULL, /* native to norm */
NULL, /* convert to native */
&TestReportNormalizePath,
@@ -356,7 +357,7 @@
&TestReportMatchInDirectory,
&TestReportUtime,
&TestReportLink,
- &TestReportListVolumes,
+ NULL /* list volumes */,
&TestReportFileAttrStrings,
&TestReportFileAttrsGet,
&TestReportFileAttrsSet,
@@ -368,8 +369,7 @@
&TestReportRenameFile,
&TestReportCopyDirectory,
&TestReportLoadFile,
- &TestReportUnloadFile,
- &TestReportGetCwd,
+ NULL /* cwd */,
&TestReportChdir
};
@@ -5257,10 +5257,62 @@
return res;
}
+static int
+TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
+ static Tcl_Obj* lastPathPtr = NULL;
+
+ if (pathPtr == lastPathPtr) {
+ /* Reject all files second time around */
+ return -1;
+ } else {
+ Tcl_Obj * newPathPtr;
+ /* Try to claim all files first time around */
+
+ newPathPtr = Tcl_DuplicateObj(pathPtr);
+ lastPathPtr = newPathPtr;
+ Tcl_IncrRefCount(newPathPtr);
+ if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) {
+ /* Nothing claimed it. Therefore we don't either */
+ Tcl_DecrRefCount(newPathPtr);
+ lastPathPtr = NULL;
+ return -1;
+ } else {
+ lastPathPtr = NULL;
+ *clientDataPtr = (ClientData) newPathPtr;
+ return TCL_OK;
+ }
+ }
+}
+
+/*
+ * Simple helper function to extract the native vfs representation of a
+ * path object, or NULL if no such representation exists.
+ */
+Tcl_Obj*
+TestReportGetNativePath(Tcl_Obj* pathObjPtr) {
+ return (Tcl_Obj*) Tcl_FSGetInternalRep(pathObjPtr, &testReportingFilesystem);
+}
+
+void
+TestReportFreeInternalRep(ClientData clientData) {
+ Tcl_Obj *nativeRep = (Tcl_Obj*)clientData;
+ if (nativeRep != NULL) {
+ /* Free the path */
+ Tcl_DecrRefCount(nativeRep);
+ }
+}
+
+ClientData
+TestReportDupInternalRep(ClientData clientData) {
+ Tcl_Obj *original = (Tcl_Obj*)clientData;
+ Tcl_IncrRefCount(original);
+ return clientData;
+}
+
static void
-TestReport(cmd, arg1, arg2)
+TestReport(cmd, path, arg2)
CONST char* cmd;
- Tcl_Obj* arg1;
+ Tcl_Obj* path;
Tcl_Obj* arg2;
{
Tcl_Interp* interp = (Tcl_Interp*) Tcl_FSData(&testReportingFilesystem);
@@ -5273,8 +5325,8 @@
Tcl_DStringAppend(&ds, "puts stderr ",-1);
Tcl_DStringStartSublist(&ds);
Tcl_DStringAppendElement(&ds, cmd);
- if (arg1 != NULL) {
- Tcl_DStringAppendElement(&ds, Tcl_GetString(arg1));
+ if (path != NULL) {
+ Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
}
if (arg2 != NULL) {
Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
@@ -5292,7 +5344,7 @@
struct stat *buf; /* Filled with results of stat call. */
{
TestReport("stat",path, NULL);
- return -1;
+ return Tcl_FSStat(TestReportGetNativePath(path),buf);
}
static int
TestReportLstat(path, buf)
@@ -5300,7 +5352,7 @@
struct stat *buf; /* Filled with results of stat call. */
{
TestReport("lstat",path, NULL);
- return -1;
+ return Tcl_FSLstat(TestReportGetNativePath(path),buf);
}
static int
TestReportAccess(path, mode)
@@ -5308,7 +5360,7 @@
int mode; /* Permission setting. */
{
TestReport("access",path,NULL);
- return -1;
+ return Tcl_FSAccess(TestReportGetNativePath(path),mode);
}
static Tcl_Channel
TestReportOpenFileChannel(interp, fileName, modeString, permissions)
@@ -5322,7 +5374,8 @@
* it? */
{
TestReport("open",fileName, NULL);
- return NULL;
+ return Tcl_FSOpenFileChannel(interp, TestReportGetNativePath(fileName),
+ modeString, permissions);
}
static int
@@ -5335,24 +5388,20 @@
* May be NULL. */
{
TestReport("matchindirectory",dirPtr, NULL);
- return -1;
-}
-static Tcl_Obj *
-TestReportGetCwd(interp)
- Tcl_Interp *interp;
-{
- TestReport("cwd",NULL,NULL);
- return NULL;
+ return Tcl_FSMatchInDirectory(interp, resultPtr,
+ TestReportGetNativePath(dirPtr), pattern,
+ types);
}
static int
TestReportChdir(dirName)
Tcl_Obj *dirName;
{
TestReport("chdir",dirName,NULL);
- return -1;
+ return Tcl_FSChdir(TestReportGetNativePath(dirName));
}
static int
-TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *fileName; /* Name of the file containing the desired
* code. */
@@ -5363,10 +5412,15 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
TestReport("loadfile",fileName,NULL);
- return -1;
+ return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), sym1, sym2,
+ proc1Ptr, proc2Ptr, clientDataPtr, unloadProcPtr);
}
static void
TestReportUnloadFile(clientData)
@@ -5383,13 +5437,7 @@
Tcl_Obj *to; /* Path of file to link to, or NULL */
{
TestReport("link",path,NULL);
- return NULL;
-}
-static Tcl_Obj *
-TestReportListVolumes()
-{
- TestReport("listvolumes",NULL,NULL);
- return NULL;
+ return Tcl_FSLink(TestReportGetNativePath(path),NULL);
}
static int
TestReportRenameFile(src, dst)
@@ -5399,7 +5447,8 @@
* (UTF-8). */
{
TestReport("renamefile",src,dst);
- return -1;
+ return Tcl_FSRenameFile(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst));
}
static int
TestReportCopyFile(src, dst)
@@ -5407,33 +5456,34 @@
Tcl_Obj *dst; /* Pathname of file to copy to (UTF-8). */
{
TestReport("copyfile",src,dst);
- return -1;
+ return Tcl_FSCopyFile(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst));
}
static int
TestReportDeleteFile(path)
Tcl_Obj *path; /* Pathname of file to be removed (UTF-8). */
{
TestReport("deletefile",path,NULL);
- return -1;
+ return Tcl_FSDeleteFile(TestReportGetNativePath(path));
}
static int
TestReportCreateDirectory(path)
Tcl_Obj *path; /* Pathname of directory to create (UTF-8). */
{
TestReport("createdirectory",path,NULL);
- return -1;
+ return Tcl_FSCreateDirectory(TestReportGetNativePath(path));
}
static int
TestReportCopyDirectory(src, dst, errorPtr)
Tcl_Obj *src; /* Pathname of directory to be copied
* (UTF-8). */
Tcl_Obj *dst; /* Pathname of target directory (UTF-8). */
- Tcl_Obj **errorPtr; /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+ Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name
+ * of file causing error. */
{
TestReport("copydirectory",src,dst);
- return -1;
+ return Tcl_FSCopyDirectory(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst), errorPtr);
}
static int
TestReportRemoveDirectory(path, recursive, errorPtr)
@@ -5442,12 +5492,12 @@
int recursive; /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
- Tcl_Obj **errorPtr; /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+ Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name
+ * of file causing error. */
{
TestReport("removedirectory",path,NULL);
- return -1;
+ return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive,
+ errorPtr);
}
static char**
TestReportFileAttrStrings(fileName, objPtrRef)
@@ -5455,7 +5505,7 @@
Tcl_Obj** objPtrRef;
{
TestReport("fileattributestrings",fileName,NULL);
- return NULL;
+ return Tcl_FSFileAttrStrings(TestReportGetNativePath(fileName), objPtrRef);
}
static int
TestReportFileAttrsGet(interp, index, fileName, objPtrRef)
@@ -5465,7 +5515,8 @@
Tcl_Obj **objPtrRef; /* for output. */
{
TestReport("fileattributesget",fileName,NULL);
- return -1;
+ return Tcl_FSFileAttrsGet(interp, index,
+ TestReportGetNativePath(fileName), objPtrRef);
}
static int
TestReportFileAttrsSet(interp, index, fileName, objPtr)
@@ -5475,7 +5526,8 @@
Tcl_Obj *objPtr; /* for input. */
{
TestReport("fileattributesset",fileName,objPtr);
- return -1;
+ return Tcl_FSFileAttrsSet(interp, index,
+ TestReportGetNativePath(fileName), objPtr);
}
static int
TestReportUtime (fileName, tval)
@@ -5483,7 +5535,7 @@
struct utimbuf *tval;
{
TestReport("utime",fileName,NULL);
- return -1;
+ return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
}
static int
TestReportNormalizePath(interp, pathPtr, nextCheckpoint)
@@ -5493,4 +5545,6 @@
{
TestReport("normalizepath",pathPtr,NULL);
return nextCheckpoint;
+ /* Tcl_FSNormalizePath(interp, TestReportGetNativePath(pathPtr),
+ nextCheckpoint);*/
}
Index: mac/tclMacLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacLoad.c,v
retrieving revision 1.5
diff -u -r1.5 tclMacLoad.c
--- mac/tclMacLoad.c 2001/08/30 08:53:15 1.5
+++ mac/tclMacLoad.c 2001/09/03 17:45:28
@@ -107,9 +107,13 @@
Tcl_PackageInitProc **proc2Ptr,
/* Where to return the addresses corresponding
* to sym1 and sym2. */
- ClientData *clientDataPtr) /* Filled with token for dynamically loaded
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr)
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
CFragConnectionID connID;
Ptr dummy;
@@ -221,6 +225,7 @@
}
*clientDataPtr = (ClientData) connID;
+ *unloadProcPtr = &TclpUnloadFile;
return TCL_OK;
}
Index: tests/fileName.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileName.test,v
retrieving revision 1.13
diff -u -r1.13 fileName.test
--- tests/fileName.test 2001/08/30 08:53:15 1.13
+++ tests/fileName.test 2001/09/03 17:45:30
@@ -318,10 +318,13 @@
set norm [string range $norm $idx end]
# fix path away so all platforms are the same
regsub -all ":" $norm "/" norm
+ # make sure we can delete the directory we created
+ cd $oldDir
file delete -force $nastydir
set norm
} err]
cd $oldDir
+ catch {file delete -force tildetmp}
list $res $err
} {0 tildetmp/~tilde}
Index: unix/tclLoadAout.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadAout.c,v
retrieving revision 1.5
diff -u -r1.5 tclLoadAout.c
--- unix/tclLoadAout.c 2001/08/30 08:53:15 1.5
+++ unix/tclLoadAout.c 2001/09/03 17:45:30
@@ -136,7 +136,8 @@
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code (UTF-8). */
@@ -147,7 +148,11 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
char * inputSymbolTable; /* Name of the file containing the
* symbol table from the last link. */
Index: unix/tclLoadDl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDl.c,v
retrieving revision 1.4
diff -u -r1.4 tclLoadDl.c
--- unix/tclLoadDl.c 2001/08/30 08:53:15 1.4
+++ unix/tclLoadDl.c 2001/09/03 17:45:30
@@ -57,7 +57,8 @@
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
@@ -68,7 +69,11 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
VOID *handle;
Tcl_DString newName, ds;
@@ -86,6 +91,8 @@
return TCL_ERROR;
}
+ *unloadProcPtr = &TclpUnloadFile;
+
/*
* Some platforms still add an underscore to the beginning of symbol
* names. If we can't find a name without an underscore, try again
Index: unix/tclLoadDld.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDld.c,v
retrieving revision 1.4
diff -u -r1.4 tclLoadDld.c
--- unix/tclLoadDld.c 2001/08/30 08:53:15 1.4
+++ unix/tclLoadDld.c 2001/09/03 17:45:30
@@ -49,7 +49,8 @@
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
@@ -60,7 +61,11 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
static int firstTime = 1;
int returnCode;
@@ -98,6 +103,7 @@
*proc2Ptr = (Tcl_PackageInitProc *) dld_get_func(sym2);
*clientDataPtr = strcpy(
(char *) ckalloc((unsigned) (strlen(fileName) + 1)), fileName);
+ *unloadProcPtr = &TclpUnloadFile;
return TCL_OK;
}
Index: unix/tclLoadDyld.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDyld.c,v
retrieving revision 1.3
diff -u -r1.3 tclLoadDyld.c
--- unix/tclLoadDyld.c 2001/08/30 08:53:15 1.3
+++ unix/tclLoadDyld.c 2001/09/03 17:45:30
@@ -40,7 +40,8 @@
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
@@ -51,7 +52,11 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
NSObjectFileImageReturnCode err;
NSObjectFileImage image;
@@ -108,7 +113,8 @@
*proc2Ptr = NSAddressOfSymbol(symbol);
*clientDataPtr = module;
-
+ *unloadProcPtr = &TclpUnloadFile;
+
return TCL_OK;
}
Index: unix/tclLoadNext.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadNext.c,v
retrieving revision 1.4
diff -u -r1.4 tclLoadNext.c
--- unix/tclLoadNext.c 2001/08/30 08:53:15 1.4
+++ unix/tclLoadNext.c 2001/09/03 17:45:30
@@ -39,7 +39,8 @@
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
@@ -50,7 +51,11 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
struct mach_header *header;
char *data;
@@ -81,7 +86,8 @@
rld_lookup(NULL,sym,(unsigned long *)proc2Ptr);
}
*clientDataPtr = NULL;
-
+ *unloadProcPtr = &TclpUnloadFile;
+
return TCL_OK;
}
Index: unix/tclLoadOSF.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadOSF.c,v
retrieving revision 1.4
diff -u -r1.4 tclLoadOSF.c
--- unix/tclLoadOSF.c 2001/08/30 08:53:15 1.4
+++ unix/tclLoadOSF.c 2001/09/03 17:45:30
@@ -60,7 +60,8 @@
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
@@ -71,7 +72,11 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
ldr_module_t lm;
char *pkg;
@@ -100,6 +105,7 @@
pkg++;
*proc1Ptr = ldr_lookup_package(pkg, sym1);
*proc2Ptr = ldr_lookup_package(pkg, sym2);
+ *unloadProcPtr = &TclpUnloadFile;
return TCL_OK;
}
Index: unix/tclLoadShl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadShl.c,v
retrieving revision 1.5
diff -u -r1.5 tclLoadShl.c
--- unix/tclLoadShl.c 2001/08/30 08:53:15 1.5
+++ unix/tclLoadShl.c 2001/09/03 17:45:30
@@ -47,7 +47,8 @@
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
@@ -58,7 +59,11 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
shl_t handle;
Tcl_DString newName;
@@ -112,6 +117,7 @@
}
Tcl_DStringFree(&newName);
}
+ *unloadProcPtr = &TclpUnloadFile;
return TCL_OK;
}
Index: unix/tclUnixPipe.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPipe.c,v
retrieving revision 1.14
diff -u -r1.14 tclUnixPipe.c
--- unix/tclUnixPipe.c 2001/08/07 00:42:45 1.14
+++ unix/tclUnixPipe.c 2001/09/03 17:45:30
@@ -238,19 +238,29 @@
Tcl_Obj*
TclpTempFileName()
{
- char fileName[L_tmpnam];
+ char fileName[L_tmpnam + 9];
+ Tcl_Obj *result = NULL;
+ int fd;
/*
- * tmpnam should not be used (see [Patch: #442636]), but mkstemp
- * doesn't provide just the filename. The use of this will have
- * to reconcile that conflict.
+ * We should also check against making more then TMP_MAX of these.
*/
- if (tmpnam(fileName) == NULL) { /* INTL: Native. */
+ strcpy(fileName, P_tmpdir); /* INTL: Native. */
+ if (fileName[strlen(fileName) - 1] != '/') {
+ strcat(fileName, "/"); /* INTL: Native. */
+ }
+ strcat(fileName, "tclXXXXXX");
+ fd = mkstemp(fileName); /* INTL: Native. */
+ if (fd == -1) {
return NULL;
}
+ fcntl(fd, F_SETFD, FD_CLOEXEC);
+ unlink(fileName); /* INTL: Native. */
- return TclpNativeToNormalized((ClientData) fileName);
+ result = TclpNativeToNormalized((ClientData) fileName);
+ close (fd);
+ return result;
}
/*
Index: win/makefile.vc
===================================================================
RCS file: /cvsroot/tcl/tcl/win/makefile.vc,v
retrieving revision 1.63
diff -u -r1.63 makefile.vc
--- win/makefile.vc 2001/09/03 00:49:34 1.63
+++ win/makefile.vc 2001/09/03 17:45:30
@@ -49,12 +49,12 @@
!ELSE
# Visual Studio 5 default
-#TOOLS32 = C:\Progra~1\devstudio\vc
-#TOOLS32_rc = C:\Progra~1\devstudio\sharedide
+TOOLS32 = C:\Progra~1\devstudio\vc
+TOOLS32_rc = C:\Progra~1\devstudio\sharedide
# Visual Studio 6 default
-TOOLS32 = C:\Progra~1\Microsoft Visual Studio\VC98
-TOOLS32_rc = C:\Progra~1\Microsoft Visual Studio\common\MSDev98
+#TOOLS32 = C:\Progra~1\Microsoft Visual Studio\VC98
+#TOOLS32_rc = C:\Progra~1\Microsoft Visual Studio\common\MSDev98
cc32 = "$(TOOLS32)\bin\cl.exe"
link32 = "$(TOOLS32)\bin\link.exe"
@@ -70,7 +70,7 @@
#THREADDEFINES = -DTCL_THREADS=1
# Set NODEBUG to 0 to compile with symbols
-NODEBUG = 1
+NODEBUG = 0
# The following defines can be used to control the amount of debugging
# code that is added to the compilation.
@@ -83,9 +83,9 @@
# needed when using Purify. For IA64, we do
# want to use the native allocator.
#
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
!IF "$(MACHINE)" == "IA64"
-DEBUGDEFINES = -DUSE_TCLALLOC=0
+#DEBUGDEFINES = -DUSE_TCLALLOC=0
!ELSE
#DEBUGDEFINES = -DUSE_TCLALLOC=0
!ENDIF
Index: win/tclWinLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinLoad.c,v
retrieving revision 1.7
diff -u -r1.7 tclWinLoad.c
--- win/tclWinLoad.c 2001/08/30 08:53:15 1.7
+++ win/tclWinLoad.c 2001/09/03 17:45:30
@@ -36,7 +36,8 @@
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
@@ -47,7 +48,11 @@
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
HINSTANCE handle;
TCHAR *nativeName;
@@ -109,8 +114,9 @@
(char *) NULL);
}
return TCL_ERROR;
+ } else {
+ *unloadProcPtr = &TclpUnloadFile;
}
-
/*
* For each symbol, check for both Symbol and _Symbol, since Borland
* generates C symbols with a leading '_' by default.
