- Add patch (sent upstream) to fix gtkThread async callbacks throwing

Queue.Empty.

lablgtk-2.14.2-avoid-queue-empty-in-gtkThread.patch

@@ -0,0 +1,40 @@
+diff -ur lablgtk-2.14.2.old/src/gtkThread.ml lablgtk-2.14.2/src/gtkThread.ml
+--- lablgtk-2.14.2.old/src/gtkThread.ml	2010-06-25 10:23:44.000000000 +0100
++++ lablgtk-2.14.2/src/gtkThread.ml	2011-07-27 19:16:32.263724495 +0100
+@@ -28,8 +28,14 @@
+ 
+ let jobs : (unit -> unit) Queue.t = Queue.create ()
+ let m = Mutex.create ()
++type ('a, 'b) either = Left of 'a | Right of 'b
+ let with_jobs f =
+-  Mutex.lock m; let y = f jobs in Mutex.unlock m; y
++  Mutex.lock m;
++  let y = try Left (f jobs) with exn -> Right exn in
++  Mutex.unlock m;
++  match y with
++  | Left y -> y
++  | Right exn -> raise exn
+ 
+ let loop_id = ref None
+ let reset () = loop_id := None
+@@ -40,8 +46,6 @@
+ let gui_safe () =
+   not (Sys.os_type = "Win32") || !loop_id = Some(Thread.id (Thread.self ()))
+ 
+-let has_jobs () = not (with_jobs Queue.is_empty)
+-let n_jobs () = with_jobs Queue.length
+ let do_next_job () = with_jobs Queue.take ()
+ let async j x = with_jobs
+     (Queue.add (fun () ->
+@@ -64,9 +68,9 @@
+ 
+ let do_jobs () =
+   Thread.delay 0.0001;
+-  for i = 1 to n_jobs () do do_next_job () done;
++  let rec loop () = do_next_job (); loop () in
++  (try loop () with Queue.Empty -> ());
+   true
+-  
+ 
+ (* We check first whether there are some event pending, and run
+    some iterations. We then need to delay, thus focing a thread switch. *)

ocaml-lablgtk.spec

@@ -2,7 +2,7 @@
 
 Name:           ocaml-lablgtk
 Version:        2.14.2
-Release:        4%{?dist}
+Release:        6%{?dist}
 
 Summary:        Objective Caml interface to gtk+
 
@@ -12,6 +12,9 @@ License:        LGPLv2 with exceptions
 URL:            http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html
 Source:         http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/dist/lablgtk-%{version}.tar.gz
 
+# Patch sent upstream 2011-07-27 by RWMJ.
+Patch0:         lablgtk-2.14.2-avoid-queue-empty-in-gtkThread.patch
+
 BuildRoot:      %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
 ExcludeArch:    sparc64 s390 s390x
 
@@ -74,6 +77,8 @@ developing applications that use %{name}.
 # version information in META file is wrong
 perl -pi -e 's|version="1.3.1"|version="%{version}"|' META
 
+%patch0 -p1
+
 
 %build
 %configure --with-gl --enable-debug
@@ -153,6 +158,10 @@ rm -rf $RPM_BUILD_ROOT
 
 
 %changelog
+* Wed Jul 27 2011 Richard W.M. Jones <rjones@redhat.com> - 2.14.2-6
+- Add patch (sent upstream) to fix gtkThread async callbacks throwing
+  Queue.Empty.
+
 * Tue Feb 08 2011 Fedora Release Engineering <rel-eng@lists.fedoraproject.org> - 2.14.2-4
 - Rebuilt for https://fedoraproject.org/wiki/Fedora_15_Mass_Rebuild