summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2003-02-04 17:06:44 (GMT)
committervincentdarley <vincentdarley>2003-02-04 17:06:44 (GMT)
commit7d7c7570591f8383688fe05c69fdea70106a937e (patch)
treec50a993eca73882fec1db93099999bb362cc7278
parentadcc02b003f61baa6211d622e14acc3500be5327 (diff)
downloadtcl-7d7c7570591f8383688fe05c69fdea70106a937e.zip
tcl-7d7c7570591f8383688fe05c69fdea70106a937e.tar.gz
tcl-7d7c7570591f8383688fe05c69fdea70106a937e.tar.bz2
finalization and test fixes
-rw-r--r--ChangeLog23
-rw-r--r--generic/tclEvent.c36
-rw-r--r--generic/tclIOUtil.c217
-rw-r--r--generic/tclInt.h4
-rw-r--r--mac/tclMacFCmd.c11
-rw-r--r--tests/basic.test10
-rw-r--r--tests/fileName.test5
-rw-r--r--tests/fileSystem.test2
-rw-r--r--tests/io.test14
-rw-r--r--unix/tclUnixFCmd.c13
-rw-r--r--win/tclWin32Dll.c33
-rw-r--r--win/tclWinFCmd.c13
-rw-r--r--win/tclWinInit.c8
-rw-r--r--win/tclWinInt.h5
14 files changed, 247 insertions, 147 deletions
diff --git a/ChangeLog b/ChangeLog
index da872c6..9f01b56 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);