always test/clear Multithreading.interrupted, indepently of thread attributes;
authorwenzelm
Tue, 08 Feb 2011 14:28:15 +0100
changeset 41714 3bafa8ba51db
parent 41713 a21084741b37
child 41715 22f8c2483bd2
always test/clear Multithreading.interrupted, indepently of thread attributes; tuned;
src/Pure/Concurrent/time_limit.ML
--- a/src/Pure/Concurrent/time_limit.ML	Tue Feb 08 14:09:24 2011 +0100
+++ b/src/Pure/Concurrent/time_limit.ML	Tue Feb 08 14:28:15 2011 +0100
@@ -1,7 +1,14 @@
 (*  Title:      Pure/Concurrent/time_limit.ML
     Author:     Makarius
 
-Execution with time limit (considerable overhead due to fork of watchdog thread).
+Execution with time limit.
+
+Notes:
+
+  * There is considerable overhead due to fork of watchdog thread.
+
+  * In rare situations asynchronous interrupts might be mistaken as
+    timeout event, and turned into exception TimeOut accidentally.
 *)
 
 signature TIME_LIMIT =
@@ -15,6 +22,8 @@
 
 exception TimeOut;
 
+val wait_time = seconds 0.0001;
+
 fun timeLimit time f x =
   Multithreading.with_attributes Multithreading.no_interrupts (fn orig_atts =>
     let
@@ -23,15 +32,13 @@
       val watchdog = Simple_Thread.fork true (fn () =>
         (OS.Process.sleep time; timeout := true; Thread.interrupt main));
 
-      val result = Exn.capture (fn () => Multithreading.with_attributes orig_atts (fn _ => f x)) ();
+      val result =
+        Exn.capture (fn () => Multithreading.with_attributes orig_atts (fn _ => f x)) ();
 
       val _ = Thread.interrupt watchdog handle Thread _ => ();
-      val _ = while Thread.isActive watchdog do OS.Process.sleep (seconds 0.0001);
+      val _ = while Thread.isActive watchdog do OS.Process.sleep wait_time;
 
-      val test =
-        Exn.capture (fn () =>
-          Multithreading.with_attributes (Multithreading.sync_interrupts orig_atts)
-            (fn _ => Thread.testInterrupt ())) ();
+      val test = Exn.capture Multithreading.interrupted ();
     in
       if ! timeout andalso (Exn.is_interrupt_exn result orelse Exn.is_interrupt_exn test)
       then raise TimeOut