gnu: ocaml-cairo2: Patch test phase.

* gnu/local.mk (ocaml-cairo2-caml_ba_array_fix.patch): Add ref.
* gnu/packages/ocaml.scm (ocaml-cairo2): Utilize patch.
* gnu/packages/patches/ocaml-cairo2-caml_ba_array-fix.patch: Add file.

2 files changed, 75 insertions, 5 deletions

diff --git a/gnu/packages/ocaml.scm b/gnu/packages/ocaml.scm
index 706def4f43..369e819573 100644
--- a/gnu/packages/ocaml.scm
+++ b/gnu/packages/ocaml.scm
@@ -5797,16 +5797,18 @@ convenience functions for vectors and matrices.")
                     (url "https://github.com/Chris00/ocaml-cairo")
                     (commit version)))
               (file-name (git-file-name name version))
+              (patches
+               (search-patches
+                ;; NOTE: This patch will be obsolete on the
+                ;; next tagged release. Remove it at that
+                ;; point.
+                "ocaml-cairo2-caml_ba_array-fix.patch"))
               (sha256
                (base32
                 "0wzysis9fa850s68qh8vrvqc6svgllhwra3kzll2ibv0wmdqrich"))))
     (build-system dune-build-system)
     (arguments
-     `(;; NOTE: GC reclaims bigarrays packed into a custom structure
-       ;; regardless of their refcounts. Affects OCaml >= 4.10.x
-       ;; https://github.com/ocaml/ocaml/issues/9360
-       #:tests? #f
-       #:test-target "tests"))
+     `(#:test-target "tests"))
     (inputs
      `(("cairo" ,cairo)
        ("gtk+-2" ,gtk+-2)
diff --git a/gnu/packages/patches/ocaml-cairo2-caml_ba_array-fix.patch b/gnu/packages/patches/ocaml-cairo2-caml_ba_array-fix.patch
new file mode 100644
index 0000000000..1ebde1997f
--- /dev/null
+++ b/gnu/packages/patches/ocaml-cairo2-caml_ba_array-fix.patch
@@ -0,0 +1,68 @@
+From 3c70f2ff18650c4794556049cd4ea22a58cc719e Mon Sep 17 00:00:00 2001
+From: Christophe Troestler <Christophe.Troestler@umons.ac.be>
+Date: Sun, 27 Sep 2020 23:20:52 +0200
+Subject: [PATCH] Do not store the Caml_ba_array_val pointer during surface
+ creation
+
+Extracted from Cairo git-tree on November 22, 2020 by
+Brett Gilio <brettg@gnu.org>
+---
+ src/cairo_stubs.c     | 3 ++-
+ tests/image_create.ml | 5 +++--
+ 2 files changed, 5 insertions(+), 3 deletions(-)
+
+diff --git a/src/cairo_stubs.c b/src/cairo_stubs.c
+index 641ee2c..200abf3 100644
+--- a/src/cairo_stubs.c
++++ b/src/cairo_stubs.c
+@@ -1580,6 +1580,7 @@ static cairo_status_t caml_cairo_image_bigarray_attach_proxy
+                                      caml_cairo_image_bigarray_finalize);
+ }
+ 
++#define b (Caml_ba_array_val(vb))
+ #define SURFACE_CREATE_DATA(name)                                       \
+   CAMLexport value caml_cairo_image_surface_create_for_##name           \
+   (value vb, value vformat, value vwidth, value vheight, value vstride) \
+@@ -1588,7 +1589,6 @@ static cairo_status_t caml_cairo_image_bigarray_attach_proxy
+     CAMLlocal1(vsurf);                                                  \
+     cairo_surface_t* surf;                                              \
+     const int width =  Int_val(vwidth);                                 \
+-    struct caml_ba_array *b = Caml_ba_array_val(vb);                    \
+     cairo_status_t status;                                              \
+                                                                         \
+     if ((b->flags & CAML_BA_MANAGED_MASK) == CAML_BA_MAPPED_FILE)       \
+@@ -1610,6 +1610,7 @@ static cairo_status_t caml_cairo_image_bigarray_attach_proxy
+ 
+ SURFACE_CREATE_DATA(data8)
+ SURFACE_CREATE_DATA(data32)
++#undef b
+ 
+ #define SURFACE_GET_DATA(type, num_dims, dims ...)                      \
+   CAMLexport value caml_cairo_image_surface_get_##type(value vsurf)     \
+diff --git a/tests/image_create.ml b/tests/image_create.ml
+index eec98d6..b13c206 100644
+--- a/tests/image_create.ml
++++ b/tests/image_create.ml
+@@ -10,6 +10,7 @@ let create() =
+ 
+ let () =
+   let cr = create() in
++  printf "With Cairo handle:\n%!";
+   set_source_rgb cr 1. 1. 1.;
+   rectangle cr 0. 0. ~w:300. ~h:300.;
+   fill cr;
+@@ -21,9 +22,9 @@ let () =
+   show_text cr "Hello";
+   Gc.compact();  Gc.compact();
+ 
+-  eprintf "Write image\n%!";
++  eprintf "- Write image\n%!";
+   PNG.write (get_target cr) "test_image.png";
+-  eprintf "Finish surface\n%!";
++  eprintf "- Finish surface\n%!";
+   Surface.finish (get_target cr);
+   Gc.compact()
+ 
+-- 
+2.29.2
+