Re: [Caml-list] crash under macos x but not win32

["Jeffrey Loren Shaw" <shawjef3@msu.edu>]

Jacques Garrigue,
Thanks for your reply! Inspired by your use of Timer.set in Tkthreads, I 
decided to use a library I keep handy for queued communication between 
threads. Using it frees me of having to type sync, async, etc a lot. The 
only major improvement now would be to make it so that you don't have to 
poll the queue. I don't know how to do that right now. 

type 'a qm =
   {q : 'a Queue.t;
    m : Mutex.t;
    c : Condition.t;
  } 

let createqm () =
 {q = Queue.create ();
  m = Mutex.create ();
  c = Condition.create ();
} 

let addtoq qm a =
 Mutex.lock qm.m;
 Queue.push a qm.q;
 Condition.signal qm.c;
 Mutex.unlock qm.m 

let getfromq_noblock qm =
 if Mutex.try_lock qm.m then
   if Queue.is_empty qm.q then
     (
	Mutex.unlock qm.m;
	None
     )
   else
     let r = Some (Queue.pop qm.q) in
     Mutex.unlock qm.m;
     r
 else
   None 

let testthree () =
 let top = openTk () in
 let l = Label.create top in
 let lconfig s () = Label.configure ~text:s l in
 let qm = createqm () in
 let loopfun () =
   ignore
     (
	Thread.create
	  (fun () ->
	    for i=0 to 5 do
	      Thread.delay 1.;
	      addtoq qm (lconfig (string_of_int i))
	    done
	  )
	  ()
     )
 in
 let b = Button.create ~text:"Run the test" ~command:loopfun top in
 let rec watcher () =
   Timer.set
     ~ms:10
     ~callback:
     (fun () ->
	match getfromq_noblock qm with
	  None -> watcher ()
	| Some f -> f (); watcher ()
     )
 in
 watcher ();
 pack [l];
 pack [b];
 mainLoop ();
 exit 0;; 

testthree ()