[ocaml-lablgtk/f16] - Add patch (sent upstream) to fix gtkThread async callbacks throwing Queue.Empty. (cherry picked

[Richard W.M. Jones]

commit f6d790f834412c43ececde675f3f584aeb418e4d
Author: Richard W.M. Jones 
Date:   Wed Jul 27 18:53:23 2011 +0100

- Add patch (sent upstream) to fix gtkThread async callbacks throwing
      Queue.Empty.
    (cherry picked from commit 120a908fae5943af36090e568ee349dfceab8be9)

...gtk-2.14.2-avoid-queue-empty-in-gtkThread.patch |   40 ++++++++++++++++++++
 ocaml-lablgtk.spec                                 |   11 +++++-
 2 files changed, 50 insertions(+), 1 deletions(-)
---
diff --git a/lablgtk-2.14.2-avoid-queue-empty-in-gtkThread.patch b/lablgtk-2.14.2-avoid-queue-empty-in-gtkThread.patch
new file mode 100644
index 0000000..80b2735
--- /dev/null
+++ b/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. *)
diff --git a/ocaml-lablgtk.spec b/ocaml-lablgtk.spec
index a8aeb7f..43d71e8 100644
--- a/ocaml-lablgtk.spec
+++ b/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-%%7Bversion%7D.ta...

+# 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  - 2.14.2-6
+- Add patch (sent upstream) to fix gtkThread async callbacks throwing
+  Queue.Empty.
+
 * Tue Feb 08 2011 Fedora Release Engineering  - 2.14.2-4
 - Rebuilt for https://fedoraproject.org/wiki/Fedora_15_Mass_Rebuild