diff options
Diffstat (limited to 'gnu')
-rw-r--r-- | gnu/local.mk | 1 | ||||
-rw-r--r-- | gnu/packages/ocaml.scm | 12 | ||||
-rw-r--r-- | gnu/packages/patches/ocaml-cairo2-caml_ba_array-fix.patch | 68 |
3 files changed, 76 insertions, 5 deletions
diff --git a/gnu/local.mk b/gnu/local.mk index 60155b0d3b..f0a5560b8f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1392,6 +1392,7 @@ dist_patch_DATA = \ %D%/packages/patches/nvi-db4.patch \ %D%/packages/patches/nyacc-binary-literals.patch \ %D%/packages/patches/ocaml-bitstring-fix-configure.patch \ + %D%/packages/patches/ocaml-cairo2-caml_ba_array-fix.patch \ %D%/packages/patches/ocaml-CVE-2015-8869.patch \ %D%/packages/patches/ocaml-Add-a-.file-directive.patch \ %D%/packages/patches/ocaml-enable-ocamldoc-reproducibility.patch \ 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 + |