From 4e68dbc1d601df57ce2d6ef3ba9a505c094a02c3 Mon Sep 17 00:00:00 2001
From: hershey <hershey@noemail.net>
Date: Tue, 20 Apr 1999 19:19:35 +0000
Subject: added a delay to a event to so it can pass on slower machines.

FossilOrigin-Name: 5e731859581ae2c08a4262d756b17ea7e69253aa
---
 tests/defs.tcl   | 34 ++++++++++++++++++++++------------
 tests/event.test |  3 ++-
 2 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/tests/defs.tcl b/tests/defs.tcl
index 727c787..999c9a9 100644
--- a/tests/defs.tcl
+++ b/tests/defs.tcl
@@ -11,7 +11,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 # 
-# RCS: @(#) $Id: defs.tcl,v 1.3 1999/04/20 18:12:18 hershey Exp $
+# RCS: @(#) $Id: defs.tcl,v 1.4 1999/04/20 19:19:35 hershey Exp $
 
 # Initialize wish shell
 
@@ -99,7 +99,10 @@ namespace eval tcltest {
 
     # tests that use thread need to know which is the main thread
 
-    set ::tcltest::mainThread [testthread names]
+    variable ::tcltest::mainThread 1
+    if {[info commands testthread] != {}} {
+	set ::tcltest::mainThread [testthread names]
+    }
 }
 
 # If there is no "memory" command (because memory debugging isn't
@@ -1052,7 +1055,8 @@ if {[info exists tk_version]} {
 
 # threadReap --
 #
-#	Kill all thread except for the main thread.
+#	Kill all threads except for the main thread.
+#	Do nothing if testthread is not defined.
 #
 # Arguments:
 #	none.
@@ -1060,18 +1064,24 @@ if {[info exists tk_version]} {
 # Results:
 #	Returns the number of existing threads.
 
-proc ::tcltest::threadReap {} {
-    testthread errorproc ThreadNullError
-    while {[llength [testthread names]] > 1} {
-	foreach tid [testthread names] {
-	    if {$tid != $::tcltest::mainThread} {
-		catch {testthread send -async $tid {testthread exit}}
-		update
+if {[info commands testthread] != {}} {
+    proc ::tcltest::threadReap {} {
+	testthread errorproc ThreadNullError
+	while {[llength [testthread names]] > 1} {
+	    foreach tid [testthread names] {
+		if {$tid != $::tcltest::mainThread} {
+		    catch {testthread send -async $tid {testthread exit}}
+		    update
+		}
 	    }
 	}
+	testthread errorproc ThreadError
+	return [llength [testthread names]]
     }
-    testthread errorproc ThreadError
-    return [llength [testthread names]]
+} else {
+    proc ::tcltest::threadReap {} {
+	return 1
+    }   
 }
 
 # Need to catch the import because it fails if defs.tcl is sourced
diff --git a/tests/event.test b/tests/event.test
index d75c959..d398b5e 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -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: event.test,v 1.4 1999/04/16 00:47:26 stanton Exp $
+# RCS: @(#) $Id: event.test,v 1.5 1999/04/20 19:19:35 hershey Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -394,6 +394,7 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc
 	close $s
     }
     set s1 [socket -server accept 5001]
+    after 1000
     set s2 [socket 127.0.0.1 5001]
     close $s1
     set x 0
-- 
cgit v0.12