commit f6d790f834412c43ececde675f3f584aeb418e4d
Author: Richard W.M. Jones <rjones@xxxxxxxxxx>
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-%{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@xxxxxxxxxx> - 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@xxxxxxxxxxxxxxxxxxxxxxx> - 2.14.2-4
- Rebuilt for https://fedoraproject.org/wiki/Fedora_15_Mass_Rebuild
_______________________________________________
ocaml-devel mailing list
ocaml-devel@xxxxxxxxxxxxxxxxxxxxxxx
https://admin.fedoraproject.org/mailman/listinfo/ocaml-devel
