testsuite/lib-threads: still working around Windows's exit bug

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13693 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 16 insertions, 7 deletions

diff --git a/testsuite/tests/lib-threads/test8.ml b/testsuite/tests/lib-threads/test8.ml
index 038f54c75..56785ed75 100644
--- a/testsuite/tests/lib-threads/test8.ml
+++ b/testsuite/tests/lib-threads/test8.ml
@@ -12,23 +12,29 @@
 
 open Event
 
-type 'a buffer_channel = { input: 'a channel; output: 'a channel }
+type 'a buffer_channel = {
+  input: 'a channel;
+  output: 'a channel;
+  thread: Thread.t;
+  finished: bool ref;
+}
 
 let new_buffer_channel() =
   let ic = new_channel() in
   let oc = new_channel() in
-  let buff = Queue.create() in
+  let finished = ref false in
   let rec buffer_process front rear =
+    if !finished then Thread.exit ();
     match (front, rear) with
-      ([], []) -> buffer_process [sync(receive ic)] []
+    | ([], []) -> buffer_process [sync(receive ic)] []
     | (hd::tl, _) ->
         select [
           wrap (receive ic) (fun x -> buffer_process front (x::rear));
           wrap (send oc hd) (fun () -> buffer_process tl rear)
         ]
     | ([], _) -> buffer_process (List.rev rear) [] in
-  Thread.create (buffer_process []) [];
-  { input = ic; output = oc }
+  let t = Thread.create (buffer_process []) [] in
+  { input = ic; output = oc; thread = t; finished = finished }
 
 let buffer_send bc data =
   sync(send bc.input data)
@@ -52,5 +58,8 @@ let g () =
   print_string (sync(buffer_receive box)); print_newline()
 
 let _ =
-  Thread.create f ();
-  g()
+  let t = Thread.create f () in
+  g();
+  box.finished := true; buffer_send box "";
+  Thread.join box.thread;
+  Thread.join t