Version française
Home     About     Download     Resources     Contact us    
Browse thread
crash under macos x but not win32
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: Jacques Garrigue <garrigue@m...>
Subject: Re: [Caml-list] crash under macos x but not win32
From: "Jeffrey Loren Shaw" <shawjef3@msu.edu>
> The following works as intended in Win32 (the ui counts slowly from 0 to 5), 
> but crashes in Mac OS X with "Bus Error". I'm running ocaml 3.09.3 installed 
> with macports. For windows I used the Ocaml 3.09.3 MinGW binary 
> distribution. 
> 
> (* looptest.ml *) 
> 
> open Tk 
> 
> let testone () =
>  let top = openTk () in
>  let l = Label.create top in
>  let loopfun () =
>    ignore
>      (
> 	Thread.create
> 	  (fun () ->
> 	    for i=0 to 5 do
> 	      Thread.delay 1.;
> 	      Label.configure ~text:(string_of_int i) l
> 	    done
> 	  )
> 	  ()
>      )
>  in
>  let b = Button.create ~text:"Run the test" ~command:loopfun top in
>  pack  [l];
>  pack [b];
>  mainLoop ();; 
> 
> testone () 
> 
> (* end looptest.ml *) 
> 
> runs with: ocaml -I +labltk -I +threads unix.cma threads.cma labltk.cma 
> looptest.ml 

The Aqua version of Tk is notoriously unstable when used with labltk,
but this doesn't seem to be the problem here. Rather, it appears not
to be reentrant (or rather not callable from several threads.) By the
way I am surprised you have no problem under Win32, which often has
reentrance problems too.

Anyway, there is a Tkthread module to solve these reentrance problems.
Here is the code using it, adding "sync" and "async" where needed.

open Tk 
open Tkthread

let tk = start () (* Calls openTk and mainLoop in a new thread *)

let testone () =
 Thread.delay 0.1; (* wait for initialization *)
 let l = sync Label.create top in
 let loopfun () =
   ignore
     (
	Thread.create
	  (fun () ->
	    for i=0 to 5 do
	      Thread.delay 1.;
	      async (Label.configure ~text:(string_of_int i)) l
	    done
	  )
	  ()
     )
 in
 let b = sync (Button.create ~text:"Run the test" ~command:loopfun) top in
 async pack  [l];
 async pack [b];
 Thread.join tk;; (* wait for mainLoop to finish *)

testone ()

And start it with

ocaml -I +labltk -I +threads unix.cma threads.cma labltk.cma tkthread.cmo looptest2.ml

The wait for initialization part is kind of hacky, as the thread start
function was rather intended for interactive use, but it should be
portable enough.

Jacques Garrigue