diff options
| -rw-r--r-- | ChangeLog | 23 | ||||
| -rw-r--r-- | generic/tclEvent.c | 36 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 217 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | mac/tclMacFCmd.c | 11 | ||||
| -rw-r--r-- | tests/basic.test | 10 | ||||
| -rw-r--r-- | tests/fileName.test | 5 | ||||
| -rw-r--r-- | tests/fileSystem.test | 2 | ||||
| -rw-r--r-- | tests/io.test | 14 | ||||
| -rw-r--r-- | unix/tclUnixFCmd.c | 13 | ||||
| -rw-r--r-- | win/tclWin32Dll.c | 33 | ||||
| -rw-r--r-- | win/tclWinFCmd.c | 13 | ||||
| -rw-r--r-- | win/tclWinInit.c | 8 | ||||
| -rw-r--r-- | win/tclWinInt.h | 5 |
14 files changed, 247 insertions, 147 deletions
@@ -1,3 +1,26 @@ +2003-01-28 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tclIOUtil.c: + * generic/tclEvent.c: + * generic/tclInt.h: + * mac/tclMacFCmd.c: + * unix/tclUnixFCmd.c: + * win/tclWin32Dll.c: + * win/tclWinFCmd.c: + * win/tclWinInit.c: + * win/tclWinInt.h: + * tests/fileSystem.test: fix to finalization/unloading/encoding + issues to make filesystem much less dependent on encodings for + its cleanup, and therefore allow it to be finalized later in the + exit process. This fixes fileSystem.test-7.1. Also fixed one + more bug in setting of modification dates of files which have + undergone cross-platform copies. [Patch 676271] + + * tests/basic.test: + * tests/fileName.test: + * tests/io.test: fixed some test failures when tests are run + from a directory containing spaces. + 2003-02-01 Kevin Kenny <kennykb@users.sourceforge.net> * generic/tclCompCmds.c: Removed an unused variable that caused diff --git a/generic/tclEvent.c b/generic/tclEvent.c index f56c61d..df1b17a 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.26 2003/01/25 03:12:01 hobbs Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.27 2003/02/04 17:06:49 vincentdarley Exp $ */ #include "tclInt.h" @@ -813,6 +813,12 @@ Tcl_Finalize() 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 @@ Tcl_Finalize() 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. */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 5e7c6b2..0b739dc 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.70 2003/01/28 14:52:47 vincentdarley Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.71 2003/02/04 17:06:50 vincentdarley Exp $ */ #include "tclInt.h" @@ -584,18 +584,14 @@ FsReleaseIterator(void) { * 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 @@ TclFinalizeFilesystem() { 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 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, */ 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 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, */ 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 @@ FSUnloadTempFile(loadHandle) (*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); } @@ -3495,7 +3540,7 @@ TclCrossFilesystemCopy(interp, source, target) Tcl_Close(interp, out); /* Set modification date of copied file */ - if (Tcl_FSLstat(source, &sourceStatBuf) != 0) { + if (Tcl_FSLstat(source, &sourceStatBuf) == 0) { tval.actime = sourceStatBuf.st_atime; tval.modtime = sourceStatBuf.st_mtime; Tcl_FSUtime(target, &tval); diff --git a/generic/tclInt.h b/generic/tclInt.h index 62a2cc3..eff764b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,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.116 2003/01/26 05:59:37 mdejong Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.117 2003/02/04 17:06:50 vincentdarley Exp $ */ #ifndef _TCLINT @@ -1661,6 +1661,7 @@ EXTERN void TclFinalizeEnvironment _ANSI_ARGS_((void)); 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 @@ EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, 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)); diff --git a/mac/tclMacFCmd.c b/mac/tclMacFCmd.c index f1a39b2..58b81c2 100644 --- a/mac/tclMacFCmd.c +++ b/mac/tclMacFCmd.c @@ -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: tclMacFCmd.c,v 1.18 2002/10/09 11:54:20 das Exp $ + * RCS: @(#) $Id: tclMacFCmd.c,v 1.19 2003/02/04 17:06:51 vincentdarley Exp $ */ #include "tclInt.h" @@ -85,7 +85,6 @@ static int DoCopyDirectory _ANSI_ARGS_((CONST char *src, 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 @@ DoCopyFile( /* *--------------------------------------------------------------------------- * - * TclpObjDeleteFile, DoDeleteFile -- + * TclpObjDeleteFile, TclpDeleteFile -- * * Removes a single file (not a directory). * @@ -505,11 +504,11 @@ int 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; diff --git a/tests/basic.test b/tests/basic.test index 52c1484..dbc5216 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: basic.test,v 1.23 2002/07/10 11:56:44 dgp Exp $ +# RCS: @(#) $Id: basic.test,v 1.24 2003/02/04 17:06:52 vincentdarley Exp $ # package require tcltest 2 @@ -587,7 +587,7 @@ test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} {exec} { } BREAKtest] set res [list [catch {exec [interpreter] $fName} msg] $msg] removeFile BREAKtest - regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res + regsub {file ".*BREAKtest"} $res {file "BREAKtest"} res set res } {1 {hello invoked "break" outside of a loop @@ -603,7 +603,7 @@ test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} {exec} { } BREAKtest] set res [list [catch {exec [interpreter] $fName} msg] $msg] removeFile BREAKtest - regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res + regsub {file ".*BREAKtest"} $res {file "BREAKtest"} res set res } {1 {invoked "break" outside of a loop while executing @@ -616,7 +616,7 @@ test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} {exec} { } BREAKtest] set res [list [catch {exec [interpreter] $fName} msg] $msg] removeFile BREAKtest - regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res + regsub {file ".*BREAKtest"} $res {file "BREAKtest"} res set res } {1 {invoked "break" outside of a loop while executing @@ -631,7 +631,7 @@ test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} {exec} { } BREAKtest] set res [list [catch {exec [interpreter] $fName} msg] $msg] removeFile BREAKtest - regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res + regsub {file ".*BREAKtest"} $res {file "BREAKtest"} res set res } {1 {command returned bad code: 2 while executing diff --git a/tests/fileName.test b/tests/fileName.test index 580ec90..5f70555 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -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: fileName.test,v 1.27 2002/11/13 22:11:41 vincentdarley Exp $ +# RCS: @(#) $Id: fileName.test,v 1.28 2003/02/04 17:06:52 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1825,6 +1825,7 @@ test filename-17.1 {windows specific special files} {testsetplatform} { # cleanup catch {file delete -force C:/globTest} +cd [temporaryDirectory] file delete -force globTest cd $oldpwd set env(HOME) $oldhome @@ -1832,6 +1833,6 @@ if {[tcltest::testConstraint testsetplatform]} { testsetplatform $platform catch {unset platform} } -catch {unset oldhome temp result} +catch {unset oldhome temp result globPreResult} ::tcltest::cleanupTests return diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 7740b34..3dbaf88 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -390,7 +390,7 @@ test filesystem-6.33 {empty file name} { while {![catch {testfilesystem 0}]} {} } -test filesystem-7.1 {load from vfs} {win knownBug} { +test filesystem-7.1 {load from vfs} {win} { # This may cause a crash on exit set dir [pwd] cd [file dirname [info nameof]] diff --git a/tests/io.test b/tests/io.test index 648f5e7..465fc3b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.37 2002/07/30 18:36:26 andreas_kupries Exp $ +# RCS: @(#) $Id: io.test,v 1.38 2003/02/04 17:06:52 vincentdarley Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -5531,12 +5531,12 @@ testConstraint testfevent [llength [info commands testfevent]] test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent} { testfevent create testfevent cmd [format { - set f [open %s r] - set x "no event" - fileevent $f readable [namespace code { - set x "f triggered: [gets $f]" - fileevent $f readable {} - }] + set f [open {%s} r] + set x "no event" + fileevent $f readable [namespace code { + set x "f triggered: [gets $f]" + fileevent $f readable {} + }] } $path(foo)] after 1 ;# We must delay because Windows takes a little time to notice update diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 4e8ca21..5a9525f 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.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: tclUnixFCmd.c,v 1.25 2002/06/28 09:56:54 dkf Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.26 2003/02/04 17:06:52 vincentdarley Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: @@ -134,7 +134,6 @@ static int CopyFileAtts _ANSI_ARGS_((CONST char *src, 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 @@ CopyFile(src, dst, statBufPtr) /* *--------------------------------------------------------------------------- * - * TclpObjDeleteFile, DoDeleteFile -- + * TclpObjDeleteFile, TclpDeleteFile -- * * Removes a single file (not a directory). * @@ -523,11 +522,11 @@ int 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 @@ TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr) { switch (type) { case DOTREE_F: { - if (DoDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { + if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { return TCL_OK; } break; diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 62d9e1c..5b939f9 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -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: tclWin32Dll.c,v 1.23 2003/01/25 14:11:32 mdejong Exp $ + * RCS: @(#) $Id: tclWin32Dll.c,v 1.24 2003/02/04 17:06:52 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -556,9 +556,37 @@ TclWinSetInterfaces( /* *--------------------------------------------------------------------------- * + * 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 @@ TclWinSetInterfaces( * *--------------------------------------------------------------------------- */ - void TclWinResetInterfaces() { - Tcl_FreeEncoding(tclWinTCharEncoding); - tclWinTCharEncoding = NULL; tclWinProcs = &asciiProcs; } diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 66d2931..28e7f27 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -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: tclWinFCmd.c,v 1.33 2003/01/25 14:11:33 mdejong Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.34 2003/02/04 17:06:53 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -99,7 +99,6 @@ static int ConvertFileNameFormat(Tcl_Interp *interp, 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 @@ _except_docopyfile_handler( /* *--------------------------------------------------------------------------- * - * TclpObjDeleteFile, DoDeleteFile -- + * TclpObjDeleteFile, TclpDeleteFile -- * * Removes a single file (not a directory). * @@ -696,11 +695,11 @@ int 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 @@ TraversalDelete( { switch (type) { case DOTREE_F: { - if (DoDeleteFile(nativeSrc) == TCL_OK) { + if (TclpDeleteFile(nativeSrc) == TCL_OK) { return TCL_OK; } break; diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 186bb89..bdfbc8f 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclWinInit.c,v 1.37 2003/01/10 15:03:55 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.38 2003/02/04 17:06:53 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -465,7 +465,7 @@ ToUtf( /* *--------------------------------------------------------------------------- * - * TclWinFilesystemAndEncodingsCleanup -- + * TclWinEncodingsCleanup -- * * Reset information to its original state in finalization to * allow for reinitialization to be possible. This must not @@ -482,9 +482,9 @@ ToUtf( */ void -TclWinFilesystemAndEncodingsCleanup() +TclWinEncodingsCleanup() { - TclWinResetInterfaces(); + TclWinResetInterfaceEncodings(); libraryPathEncodingFixed = 0; if (binaryEncoding != NULL) { Tcl_FreeEncoding(binaryEncoding); diff --git a/win/tclWinInt.h b/win/tclWinInt.h index c9be10d..0e0f11d 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinInt.h,v 1.19 2003/01/10 15:03:55 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinInt.h,v 1.20 2003/02/04 17:06:53 vincentdarley Exp $ */ #ifndef _TCLWININT @@ -112,7 +112,8 @@ EXTERN TclWinProcs *tclWinProcs; * 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); |