Attachment "tclFinalize.diff" to
ticket [676271ffff]
added by
vincentdarley
2003-01-29 02:06:05.
? tclFinalize.diff
? win/efile
? win/globTest
Index: generic/tclEvent.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEvent.c,v
retrieving revision 1.26
diff -u -r1.26 tclEvent.c
--- generic/tclEvent.c 25 Jan 2003 03:12:01 -0000 1.26
+++ generic/tclEvent.c 28 Jan 2003 18:55:54 -0000
@@ -813,6 +813,16 @@
TclFinalizeEnvironment();
/*
+ * Finalizing the filesystem must come after anything which
+ * might conceivably interact with the 'Tcl_FS' API. This
+ * will also unload any extensions which have been loaded.
+ * However, it also needs access to the encoding subsystem
+ * during finalization, so that system must still be intact
+ * at this point.
+ */
+ TclFinalizeFilesystem();
+
+ /*
* We must be sure the encoding finalization doesn't need
* to examine the filesystem in any way. Since it only
* needs to clean up internal data structures, this is
@@ -843,22 +853,17 @@
TclFinalizeSynchronization();
/*
- * FIX FIX FIX:
- * There is a conflict here between what apps need when for
- * finalization. There is the encoding note below that
- * relates to tclkits, but there is the clear problem in a
- * standard threaded build that you must finalize the sync
- * objects before the filesystem to handle tsdPtr's in
- * extensions (example: dde). -- hobbs
+ * We defer unloading of packages until very late
+ * to avoid memory access issues. Both exit callbacks and
+ * synchronization variables may be stored in packages.
*
- * Finalizing the filesystem must come after anything which
- * might conceivably interact with the 'Tcl_FS' API. This
- * will also unload any extensions which have been loaded.
- * However, it also needs access to the encoding subsystem
- * during finalization, so that system must still be intact
- * at this point.
+ * Note that TclFinalizeLoad unloads packages in the reverse
+ * of the order they were loaded in (i.e. last to be loaded
+ * is the first to be unloaded). This can be important for
+ * correct unloading when dependencies exist.
*/
- TclFinalizeFilesystem();
+
+ TclFinalizeLoad();
/*
* There shouldn't be any malloc'ed memory after this.
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.70
diff -u -r1.70 tclIOUtil.c
--- generic/tclIOUtil.c 28 Jan 2003 14:52:47 -0000 1.70
+++ generic/tclIOUtil.c 28 Jan 2003 18:55:54 -0000
@@ -612,33 +612,24 @@
cwdPathPtr = NULL;
}
- /*
- * We defer unloading of packages until very late
- * to avoid memory access issues. Both exit callbacks and
- * synchronization variables may be stored in packages.
- *
- * Note that TclFinalizeLoad unloads packages in the reverse
- * of the order they were loaded in (i.e. last to be loaded
- * is the first to be unloaded). This can be important for
- * correct unloading when dependencies exist.
+ /*
+ * Remove all filesystems, freeing any allocated memory
+ * that is no longer needed
*/
-
- TclFinalizeLoad();
-
- /* Remove all filesystems, freeing any allocated memory */
while (filesystemList != NULL) {
FilesystemRecord *tmpFsRecPtr = filesystemList->nextPtr;
- if (filesystemList->fileRefCount > 1) {
+ if (filesystemList->fileRefCount > 0) {
/*
- * We are freeing a filesystem which actually has
- * path objects still around which belong to it.
- * This is probably bad, but since we are exiting,
- * we don't do anything about it.
+ * This filesystem must have some path objects still
+ * around which will be freed later (e.g. when unloading
+ * any shared libraries). If not, then someone is
+ * causing us to leak memory.
*/
- }
- /* The native filesystem is static, so we don't free it */
- if (filesystemList != &nativeFilesystemRecord) {
- ckfree((char *)filesystemList);
+ } else {
+ /* The native filesystem is static, so we don't free it */
+ if (filesystemList != &nativeFilesystemRecord) {
+ ckfree((char *)filesystemList);
+ }
}
filesystemList = tmpFsRecPtr;
}
@@ -649,6 +640,13 @@
accessProcList = NULL;
openFileChannelProcList = NULL;
filesystemList = &nativeFilesystemRecord;
+
+ /*
+ * Note, at this point, I believe nativeFilesystemRecord ->
+ * fileRefCount should equal 1 and if not, we should try to track
+ * down the cause.
+ */
+
filesystemIteratorsInProgress = 0;
filesystemWantToModify = 0;
#ifdef TCL_THREADS
@@ -2634,8 +2632,16 @@
*/
if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
Tcl_DecrRefCount(copyToPtr);
- (*handlePtr) = NULL;
- (*unloadProcPtr) = NULL;
+ /*
+ * We tell our caller about the real shared
+ * library which was loaded. Note that this
+ * does mean that the package list maintained
+ * by 'load' will store the original (vfs)
+ * path alongside the temporary load handle
+ * and unload proc ptr.
+ */
+ (*handlePtr) = newLoadHandle;
+ (*unloadProcPtr) = newUnloadProcPtr;
return TCL_OK;
}
/*
@@ -2652,24 +2658,37 @@
*/
tvdlPtr->loadHandle = newLoadHandle;
tvdlPtr->unloadProcPtr = newUnloadProcPtr;
- /* copyToPtr is already incremented for this reference */
- tvdlPtr->divertedFile = copyToPtr;
- /*
- * This is the filesystem we loaded it into. It is
- * almost certainly the tclNativeFilesystem, but we don't
- * want to make that assumption. Since we have a
- * reference to 'copyToPtr', we already have a refCount
- * on this filesystem, so we don't need to worry about it
- * disappearing on us.
- */
- tvdlPtr->divertedFilesystem = copyFsPtr;
- /* Get the native representation of the file path */
- tvdlPtr->divertedFileNativeRep = Tcl_FSGetInternalRep(copyToPtr,
- copyFsPtr);
+
+ if (copyFsPtr != &tclNativeFilesystem) {
+ /* copyToPtr is already incremented for this reference */
+ tvdlPtr->divertedFile = copyToPtr;
+
+ /*
+ * This is the filesystem we loaded it into. Since
+ * we have a reference to 'copyToPtr', we already
+ * have a refCount on this filesystem, so we don't
+ * need to worry about it disappearing on us.
+ */
+ tvdlPtr->divertedFilesystem = copyFsPtr;
+ tvdlPtr->divertedFileNativeRep = NULL;
+ } else {
+ /* We need the native rep */
+ tvdlPtr->divertedFileNativeRep =
+ NativeDupInternalRep(Tcl_FSGetInternalRep(copyToPtr,
+ copyFsPtr));
+ /*
+ * We don't need or want references to the copied
+ * Tcl_Obj or the filesystem if it is the native
+ * one.
+ */
+ tvdlPtr->divertedFile = NULL;
+ tvdlPtr->divertedFilesystem = NULL;
+ Tcl_DecrRefCount(copyToPtr);
+ }
+
copyToPtr = NULL;
(*handlePtr) = (Tcl_LoadHandle) tvdlPtr;
(*unloadProcPtr) = &FSUnloadTempFile;
-
return retVal;
} else {
/* Cross-platform copy failed */
@@ -2769,39 +2788,47 @@
(*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
}
- /* Remove the temporary file we created. */
- if (Tcl_FSDeleteFile(tvdlPtr->divertedFile) != TCL_OK) {
+ if (tvdlPtr->divertedFilesystem == NULL) {
/*
- * The above may have failed because the filesystem, or something
- * it depends upon (e.g. encodings) are being taken down because
- * Tcl is exiting.
- *
- * Therefore we try to call the filesystem's 'delete file proc'
- * directly. Note that this call may still cause problems, because
- * it will ask for the native representation of the divertedFile,
- * and that may need to be _recalculated_, in which case this
- * call isn't very different to the above. What we could do
- * instead is generate a new Tcl_Obj (pure native) by calling:
- *
- * Tcl_Obj *tmp = Tcl_FSNewNativePath(tvdlPtr->divertedFile,
- * tvdlPtr->divertedFileNativeRep);
- * Tcl_IncrRefCount(tmp);
- * tvdlPtr->divertedFilesystem->deleteFileProc(tmp);
- * Tcl_DecrRefCount(tmp);
- *
- * and then use that in this call. This approach would potentially
- * work even if the encodings and everything else have been
- * deconstructed. For the moment, however, we simply assume
- * Tcl_FSDeleteFile has worked correctly.
+ * It was the native filesystem, and we have a special
+ * function available just for this purpose, which we
+ * know works even at this late stage.
+ */
+ TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
+ NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
+ } else {
+ /*
+ * Remove the temporary file we created. Note, we may crash
+ * here because encodings have been taken down already.
+ */
+ if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
+ != TCL_OK) {
+ /*
+ * The above may have failed because the filesystem, or something
+ * it depends upon (e.g. encodings) have been taken down because
+ * Tcl is exiting.
+ *
+ * We may need to work out how to delete this file more
+ * robustly (or give the filesystem the information it needs
+ * to delete the file more robustly).
+ *
+ * In particular, one problem might be that the filesystem
+ * cannot extract the information it needs from the above
+ * path object because Tcl's entire filesystem apparatus
+ * (the code in this file) has been finalized, and it
+ * refuses to pass the internal representation to the
+ * filesystem.
+ */
+ }
+
+ /*
+ * And free up the allocations. This will also of course remove
+ * a refCount from the Tcl_Filesystem to which this file belongs,
+ * which could then free up the filesystem if we are exiting.
*/
+ Tcl_DecrRefCount(tvdlPtr->divertedFile);
}
-
- /*
- * And free up the allocations. This will also of course remove
- * a refCount from the Tcl_Filesystem to which this file belongs,
- * which could then free up the filesystem if we are exiting.
- */
- Tcl_DecrRefCount(tvdlPtr->divertedFile);
+
ckfree((char*)tvdlPtr);
}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.116
diff -u -r1.116 tclInt.h
--- generic/tclInt.h 26 Jan 2003 05:59:37 -0000 1.116
+++ generic/tclInt.h 28 Jan 2003 18:55:55 -0000
@@ -1716,6 +1716,7 @@
Tcl_StatBuf *buf));
EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void));
EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void));
+EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path));
EXTERN void TclpFinalizeCondition _ANSI_ARGS_((
Tcl_Condition *condPtr));
EXTERN void TclpFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
Index: mac/tclMacFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacFCmd.c,v
retrieving revision 1.18
diff -u -r1.18 tclMacFCmd.c
--- mac/tclMacFCmd.c 9 Oct 2002 11:54:20 -0000 1.18
+++ mac/tclMacFCmd.c 28 Jan 2003 18:55:57 -0000
@@ -85,7 +85,6 @@
static int DoCopyFile _ANSI_ARGS_((CONST char *src,
CONST char *dst));
static int DoCreateDirectory _ANSI_ARGS_((CONST char *path));
-static int DoDeleteFile _ANSI_ARGS_((CONST char *path));
static int DoRemoveDirectory _ANSI_ARGS_((CONST char *path,
int recursive, Tcl_DString *errorPtr));
static int DoRenameFile _ANSI_ARGS_((CONST char *src,
@@ -482,7 +481,7 @@
/*
*---------------------------------------------------------------------------
*
- * TclpObjDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, TclpDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -505,11 +504,11 @@
TclpObjDeleteFile(pathPtr)
Tcl_Obj *pathPtr;
{
- return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
+ return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
-static int
-DoDeleteFile(
+int
+TclpDeleteFile(
CONST char *path) /* Pathname of file to be removed (native). */
{
OSErr err;
Index: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.25
diff -u -r1.25 tclUnixFCmd.c
--- unix/tclUnixFCmd.c 28 Jun 2002 09:56:54 -0000 1.25
+++ unix/tclUnixFCmd.c 28 Jan 2003 18:55:58 -0000
@@ -134,7 +134,6 @@
static int DoCopyFile _ANSI_ARGS_((CONST char *srcPtr,
CONST char *dstPtr));
static int DoCreateDirectory _ANSI_ARGS_((CONST char *pathPtr));
-static int DoDeleteFile _ANSI_ARGS_((CONST char *path));
static int DoRemoveDirectory _ANSI_ARGS_((Tcl_DString *pathPtr,
int recursive, Tcl_DString *errorPtr));
static int DoRenameFile _ANSI_ARGS_((CONST char *src,
@@ -500,7 +499,7 @@
/*
*---------------------------------------------------------------------------
*
- * TclpObjDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, TclpDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -523,11 +522,11 @@
TclpObjDeleteFile(pathPtr)
Tcl_Obj *pathPtr;
{
- return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
+ return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
-static int
-DoDeleteFile(path)
+int
+TclpDeleteFile(path)
CONST char *path; /* Pathname of file to be removed (native). */
{
if (unlink(path) != 0) { /* INTL: Native. */
@@ -995,7 +994,7 @@
{
switch (type) {
case DOTREE_F: {
- if (DoDeleteFile(Tcl_DStringValue(srcPtr)) == 0) {
+ if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) {
return TCL_OK;
}
break;
Index: win/tclWinFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFCmd.c,v
retrieving revision 1.33
diff -u -r1.33 tclWinFCmd.c
--- win/tclWinFCmd.c 25 Jan 2003 14:11:33 -0000 1.33
+++ win/tclWinFCmd.c 28 Jan 2003 18:55:58 -0000
@@ -99,7 +99,6 @@
Tcl_Obj **attributePtrPtr);
static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr);
static int DoCreateDirectory(CONST TCHAR *pathPtr);
-static int DoDeleteFile(CONST TCHAR *pathPtr);
static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc,
int ignoreError, Tcl_DString *errorPtr);
static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
@@ -670,7 +669,7 @@
/*
*---------------------------------------------------------------------------
*
- * TclpObjDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, TclpDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -696,11 +695,11 @@
TclpObjDeleteFile(pathPtr)
Tcl_Obj *pathPtr;
{
- return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
+ return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
-static int
-DoDeleteFile(
+int
+TclpDeleteFile(
CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */
{
DWORD attr;
@@ -1380,7 +1379,7 @@
{
switch (type) {
case DOTREE_F: {
- if (DoDeleteFile(nativeSrc) == TCL_OK) {
+ if (TclpDeleteFile(nativeSrc) == TCL_OK) {
return TCL_OK;
}
break;
