Index: tests/async.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/async.test,v
retrieving revision 1.5
diff -u -r1.5 async.test
--- tests/async.test	10 Apr 2000 17:18:56 -0000	1.5
+++ tests/async.test	4 Jun 2003 22:19:54 -0000
@@ -25,6 +25,10 @@
     return
 }
 
+tcltest::testConstraint threaded \
+    [expr { [info exists ::tcl_platform(threaded)]
+	    && $::tcl_platform(threaded) }]
+
 proc async1 {result code} {
     global aresult acode
     set aresult $result
@@ -133,19 +137,57 @@
     list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
 } {3 del2 {0 0 0 del1 del2}}
 
+proc nothing {} {
+    # empty proc
+}
+proc hang1 { handle } {
+    global aresult
+    set aresult {Async event not delivered}
+    testasync marklater $handle
+    for { set i 0 } { $i < 1000000 && $aresult eq "Async event not delivered" } { incr i } {
+	nothing
+    }
+    return $aresult
+}
+proc hang2 { handle } {
+    global aresult
+    set aresult {Async event not delivered}
+    testasync marklater $handle
+    for { set i 0 } { $i < 1000000 && $aresult eq "Async event not delivered" } { incr i } {}
+    return $aresult
+}
+
+test async-4.1 {async interrupting bytecode sequence} \
+    -constraints threaded \
+    -setup {
+	set hm [testasync create async3]
+    } \
+    -body {
+	hang1 $hm
+    } \
+    -cleanup {
+	testasync delete $hm
+    } \
+    -result {test pattern}
+
+test async-4.2 {async interrupting straight bytecode sequence} \
+    -constraints threaded \
+    -setup {
+	set hm [testasync create async3]
+    } \
+    -body {
+	hang2 $hm
+    } \
+    -cleanup {
+	testasync delete $hm
+    } \
+    -result {test pattern}
+
 # cleanup
 testasync delete
 ::tcltest::cleanupTests
 return
 
-
-
-
-
-
-
-
-
-
-
-
+# Local Variables:
+# mode: tcl
+# End:
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.67
diff -u -r1.67 tclTest.c
--- generic/tclTest.c	16 Apr 2003 23:33:44 -0000	1.67
+++ generic/tclTest.c	4 Jun 2003 22:19:54 -0000
@@ -129,6 +129,9 @@
 int			Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
 static int		AsyncHandlerProc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int code));
+#ifdef TCL_THREADS
+static Tcl_ThreadCreateType AsyncThreadProc _ANSI_ARGS_((ClientData));
+#endif
 static void		CleanupTestSetassocdataTests _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp));
 static void		CmdDelProc1 _ANSI_ARGS_((ClientData clientData));
@@ -828,6 +831,30 @@
 	}
 	Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE);
 	return code;
+#ifdef TCL_THREADS
+    } else if ( strcmp( argv[1], "marklater" ) == 0 ) {
+	if ( argc != 3 ) {
+	    goto wrongNumArgs;
+	}
+	if ( Tcl_GetInt( interp, argv[2], &id ) != TCL_OK ) {
+	    return TCL_ERROR;
+	}
+	for (asyncPtr = firstHandler; asyncPtr != NULL;
+		asyncPtr = asyncPtr->nextPtr) {
+	    if (asyncPtr->id == id) {
+		Tcl_ThreadId threadID;
+		if ( Tcl_CreateThread( &threadID,
+				       AsyncThreadProc,
+				       (ClientData) asyncPtr,
+				       TCL_THREAD_STACK_DEFAULT,
+				       TCL_THREAD_NOFLAGS ) != TCL_OK ) {
+		    Tcl_SetResult( interp, "can't create thread", TCL_STATIC );
+		    return TCL_ERROR;
+		}
+		break;
+	    }
+	}
+#endif
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
 		"\": must be create, delete, int, or mark",
@@ -866,6 +893,37 @@
     ckfree((char *)cmd);
     return code;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AsyncThreadProc --
+ *
+ *	Delivers an asynchronous event to a handler in another thread.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Invokes Tcl_AsyncMark on the handler
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_THREADS
+static Tcl_ThreadCreateType
+AsyncThreadProc( ClientData clientData )
+				/* Parameter is a pointer to a */
+				/* TestAsyncHandler, defined above */
+{
+
+    TestAsyncHandler* asyncPtr = clientData;
+    Tcl_Sleep( 1 );
+    Tcl_AsyncMark( asyncPtr->handler );
+    Tcl_ExitThread( TCL_OK );
+    TCL_THREAD_CREATE_RETURN;
+}
+#endif
 
 /*
  *----------------------------------------------------------------------
