Attachment "tclFinalize2.diff" to
ticket [676271ffff]
added by
vincentdarley
2003-01-29 17:53:48.
? tclFinalize2.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 29 Jan 2003 10:47:34 -0000
@@ -813,6 +813,12 @@
TclFinalizeEnvironment();
/*
+ * Finalizing the filesystem must come after anything which
+ * might conceivably interact with the 'Tcl_FS' API.
+ */
+ 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,23 +849,23 @@
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.
+ *
+ * Once load has been finalized, we will have deleted any
+ * temporary copies of shared libraries and can therefore
+ * reset the filesystem to its original state.
*/
- TclFinalizeFilesystem();
+ TclFinalizeLoad();
+ TclResetFilesystem();
+
/*
* 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 29 Jan 2003 10:47:35 -0000
@@ -584,18 +584,14 @@
* Clean up the filesystem. After this, calls to all Tcl_FS...
* functions will fail.
*
- * Note that, since 'TclFinalizeLoad' may unload extensions
- * which implement other filesystems, and which may therefore
- * contain a 'freeProc' for those filesystems, at this stage
- * we _must_ have freed all objects of "path" type, or we may
- * end up with segfaults if we try to free them later.
- *
+ * We will later call TclResetFilesystem to restore the FS
+ * to a pristine state.
+ *
* Results:
* None.
*
* Side effects:
- * Frees any memory allocated by the filesystem. Unloads any
- * extensions which have been loaded.
+ * Frees any memory allocated by the filesystem.
*
*----------------------------------------------------------------------
*/
@@ -612,56 +608,76 @@
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;
}
/*
- * Now filesystemList is NULL. Reset statics to original state.
+ * Now filesystemList is NULL. This means that any attempt
+ * to use the filesystem is likely to fail.
*/
statProcList = NULL;
accessProcList = NULL;
openFileChannelProcList = NULL;
+#ifdef __WIN32__
+ TclWinEncodingsCleanup();
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclResetFilesystem --
+ *
+ * Restore the filesystem to a pristine state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclResetFilesystem() {
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
filesystemOkToModify = NULL;
#endif
+#ifdef __WIN32__
/*
- * Cleans up the win32 API filesystem proc lookup table and
- * any special encodings which have been loaded. This must
- * happen after the filesystem has been closed down, or crashes
- * can result (especially with vfs).
+ * Cleans up the win32 API filesystem proc lookup table. This must
+ * happen very late in finalization so that deleting of copied
+ * dlls can occur.
*/
-#ifdef __WIN32__
- TclWinFilesystemAndEncodingsCleanup();
+ TclWinResetInterfaces();
#endif
}
@@ -2634,8 +2650,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 +2676,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 +2806,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 29 Jan 2003 10:47:36 -0000
@@ -1661,6 +1661,7 @@
EXTERN void TclFinalizeExecution _ANSI_ARGS_((void));
EXTERN void TclFinalizeIOSubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeFilesystem _ANSI_ARGS_((void));
+EXTERN void TclResetFilesystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeLoad _ANSI_ARGS_((void));
EXTERN void TclFinalizeMemorySubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeNotifier _ANSI_ARGS_((void));
@@ -1716,6 +1717,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 29 Jan 2003 10:47:38 -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 29 Jan 2003 10:47:39 -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/tclWin32Dll.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWin32Dll.c,v
retrieving revision 1.23
diff -u -r1.23 tclWin32Dll.c
--- win/tclWin32Dll.c 25 Jan 2003 14:11:32 -0000 1.23
+++ win/tclWin32Dll.c 29 Jan 2003 10:47:39 -0000
@@ -556,9 +556,37 @@
/*
*---------------------------------------------------------------------------
*
+ * TclWinResetInterfaceEncodings --
+ *
+ * Called during finalization to free up any encodings we use.
+ * The tclWinProcs-> look up table is still ok to use after
+ * this call, provided no encoding conversion is required.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+TclWinResetInterfaceEncodings()
+{
+ if (tclWinTCharEncoding != NULL) {
+ Tcl_FreeEncoding(tclWinTCharEncoding);
+ tclWinTCharEncoding = NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclWinResetInterfaces --
*
* Called during finalization to reset us to a safe state for reuse.
+ * After this call, it is best not to use the tclWinProcs-> look
+ * up table since it is likely to be different to what is expected.
*
* Results:
* None.
@@ -568,12 +596,9 @@
*
*---------------------------------------------------------------------------
*/
-
void
TclWinResetInterfaces()
{
- Tcl_FreeEncoding(tclWinTCharEncoding);
- tclWinTCharEncoding = NULL;
tclWinProcs = &asciiProcs;
}
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 29 Jan 2003 10:47:39 -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;
Index: win/tclWinInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinInit.c,v
retrieving revision 1.37
diff -u -r1.37 tclWinInit.c
--- win/tclWinInit.c 10 Jan 2003 15:03:55 -0000 1.37
+++ win/tclWinInit.c 29 Jan 2003 10:47:39 -0000
@@ -465,7 +465,7 @@
/*
*---------------------------------------------------------------------------
*
- * TclWinFilesystemAndEncodingsCleanup --
+ * TclWinEncodingsCleanup --
*
* Reset information to its original state in finalization to
* allow for reinitialization to be possible. This must not
@@ -482,9 +482,9 @@
*/
void
-TclWinFilesystemAndEncodingsCleanup()
+TclWinEncodingsCleanup()
{
- TclWinResetInterfaces();
+ TclWinResetInterfaceEncodings();
libraryPathEncodingFixed = 0;
if (binaryEncoding != NULL) {
Tcl_FreeEncoding(binaryEncoding);
Index: win/tclWinInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinInt.h,v
retrieving revision 1.19
diff -u -r1.19 tclWinInt.h
--- win/tclWinInt.h 10 Jan 2003 15:03:55 -0000 1.19
+++ win/tclWinInt.h 29 Jan 2003 10:47:39 -0000
@@ -112,7 +112,8 @@
* stubs table.
*/
-EXTERN void TclWinFilesystemAndEncodingsCleanup();
+EXTERN void TclWinEncodingsCleanup();
+EXTERN void TclWinResetInterfaceEncodings();
EXTERN void TclWinInit(HINSTANCE hInst);
EXTERN int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal,
CONST TCHAR* LinkCopy);
