diff options
author | hobbs <hobbs@noemail.net> | 1999-10-21 02:17:43 (GMT) |
---|---|---|
committer | hobbs <hobbs@noemail.net> | 1999-10-21 02:17:43 (GMT) |
commit | f494f26e3a8f97f6a2c78510f52548224e000b97 (patch) | |
tree | 7b90e259557aafc0fc008e407a22852a227c15d9 /library | |
parent | 0946b1961c3c20524d3190af3f09a966ce121210 (diff) | |
download | tcl-f494f26e3a8f97f6a2c78510f52548224e000b97.zip tcl-f494f26e3a8f97f6a2c78510f52548224e000b97.tar.gz tcl-f494f26e3a8f97f6a2c78510f52548224e000b97.tar.bz2 |
Changed update to 'after 1' to cause a true sleep in the current
thread, avoiding numerous superfluous thread send calls.
FossilOrigin-Name: 77f0c7a3671cfa1bca231515373cf757251b34f8
Diffstat (limited to 'library')
-rw-r--r-- | library/tcltest/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | library/tcltest/tcltest.tcl | 7 | ||||
-rw-r--r-- | library/tcltest1.0/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | library/tcltest1.0/tcltest.tcl | 7 |
4 files changed, 12 insertions, 6 deletions
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index c79a8b0..205cbbb 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -14,4 +14,4 @@ package ifneeded tcltest 1.0 [list tclPkgSetup $dir tcltest 1.0 \ ::tcltest::removeDirectory ::tcltest::removeFile \ ::tcltest::restoreState ::tcltest::saveState ::tcltest::test \ ::tcltest::threadReap ::tcltest::viewFile ::tcltest::grep \ - ::tcltest::getMatchingFiles ::tcltest::loadTestedCommands}}}] + ::tcltest::getMatchingFiles ::tcltest::loadTestedCommands}}}] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 0fd2090..55631aa 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -12,7 +12,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.16 1999/10/20 01:27:05 jenn Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.17 1999/10/21 02:17:43 hobbs Exp $ package provide tcltest 1.0 @@ -1860,9 +1860,12 @@ proc ::tcltest::threadReap {} { foreach tid [testthread names] { if {$tid != $::tcltest::mainThread} { catch {testthread send -async $tid {testthread exit}} - update } } + ## Enter a bit a sleep to give the threads enough breathing + ## room to kill themselves off, otherwise the end up with a + ## massive queue of repeated events + after 1 } testthread errorproc ThreadError return [llength [testthread names]] diff --git a/library/tcltest1.0/pkgIndex.tcl b/library/tcltest1.0/pkgIndex.tcl index c79a8b0..205cbbb 100644 --- a/library/tcltest1.0/pkgIndex.tcl +++ b/library/tcltest1.0/pkgIndex.tcl @@ -14,4 +14,4 @@ package ifneeded tcltest 1.0 [list tclPkgSetup $dir tcltest 1.0 \ ::tcltest::removeDirectory ::tcltest::removeFile \ ::tcltest::restoreState ::tcltest::saveState ::tcltest::test \ ::tcltest::threadReap ::tcltest::viewFile ::tcltest::grep \ - ::tcltest::getMatchingFiles ::tcltest::loadTestedCommands}}}] + ::tcltest::getMatchingFiles ::tcltest::loadTestedCommands}}}] diff --git a/library/tcltest1.0/tcltest.tcl b/library/tcltest1.0/tcltest.tcl index 0fd2090..55631aa 100644 --- a/library/tcltest1.0/tcltest.tcl +++ b/library/tcltest1.0/tcltest.tcl @@ -12,7 +12,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.16 1999/10/20 01:27:05 jenn Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.17 1999/10/21 02:17:43 hobbs Exp $ package provide tcltest 1.0 @@ -1860,9 +1860,12 @@ proc ::tcltest::threadReap {} { foreach tid [testthread names] { if {$tid != $::tcltest::mainThread} { catch {testthread send -async $tid {testthread exit}} - update } } + ## Enter a bit a sleep to give the threads enough breathing + ## room to kill themselves off, otherwise the end up with a + ## massive queue of repeated events + after 1 } testthread errorproc ThreadError return [llength [testthread names]] |