Merge with ocaml trunk 12778 -> 13774

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

1 files changed, 20 insertions, 5 deletions

diff --git a/testsuite/tests/lib-threads/token2.ml b/testsuite/tests/lib-threads/token2.ml
index 32f2c6ed37..9ef05806ef 100644
--- a/testsuite/tests/lib-threads/token2.ml
+++ b/testsuite/tests/lib-threads/token2.ml
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Performance test for I/O scheduling *)
 
 let mut = Mutex.create()
@@ -7,13 +19,13 @@ let niter = ref 0
 let token = ref 0
 
 let process (n, ins, outs, nprocs) =
-  let buf = String.create 1 in
-  while true do
+  let buf = String.make 1 '.' in
+  while buf <> "-" do
     Unix.read ins.(n) buf 0 1;
     (* Printf.printf "Thread %d got the token\n" n; *)
     if n = 0 then begin
       decr niter;
-      if !niter <= 0 then exit 0
+      if !niter <= 0 then buf.[0] <- '-';
     end;
     let next = if n + 1 >= nprocs then 0 else n + 1 in
     (* Printf.printf "Thread %d sending token to thread %d\n" n next; *)
@@ -25,12 +37,15 @@ let main() =
   let iter = try int_of_string Sys.argv.(2) with _ -> 1000 in
   let ins = Array.create nprocs Unix.stdin in
   let outs = Array.create nprocs Unix.stdout in
+  let threads = Array.create nprocs (Thread.self ()) in
   for n = 0 to nprocs - 1 do
     let (i, o) = Unix.pipe() in ins.(n) <- i; outs.(n) <- o
   done;
   niter := iter;
-  for i = 0 to nprocs - 1 do Thread.create process (i, ins, outs, nprocs) done;
+  for i = 0 to nprocs - 1 do
+    threads.(i) <- Thread.create process (i, ins, outs, nprocs)
+  done;
   Unix.write outs.(0) "X" 0 1;
-  Thread.delay 3600.
+  for i = 0 to nprocs - 1 do Thread.join threads.(i) done
 
 let _ = main()