From b4f876b464127efea27a42767a783434be9b4465 Mon Sep 17 00:00:00 2001
From: Vesa Karvonen <vesa.a.j.k@gmail.com>
Date: Fri, 28 Jul 2023 17:57:53 +0300
Subject: [PATCH] Fix to not cause segfault on float arrays

---
 src/Multicore_magic.ml       |  5 +++--
 test/Multicore_magic_test.ml | 19 +++++++++++++++----
 2 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/src/Multicore_magic.ml b/src/Multicore_magic.ml
index 68f7d02..9d852fc 100644
--- a/src/Multicore_magic.ml
+++ b/src/Multicore_magic.ml
@@ -9,8 +9,9 @@ let copy_as_padded (o : 'a) : 'a =
   Obj.magic n
 
 let make_padded_array n x =
-  let a = Array.make (n + num_padding_words) (Obj.magic ()) in
-  if x != Obj.magic () then Array.fill a 0 n x;
+  let a = Array.make (n + num_padding_words) x in
+  if Obj.is_block (Obj.repr x) && Obj.tag (Obj.repr x) != Obj.double_tag then
+    Array.fill a n num_padding_words (Obj.magic ());
   a
 
 let[@inline] length_of_padded_array x = Array.length x - num_padding_words
diff --git a/test/Multicore_magic_test.ml b/test/Multicore_magic_test.ml
index f8bf9ef..e3f6d9b 100644
--- a/test/Multicore_magic_test.ml
+++ b/test/Multicore_magic_test.ml
@@ -5,11 +5,11 @@ let can_pad_atomic () =
 
 let can_pad_records () =
   let open struct
-    type record = { foo : int; bar : int Atomic.t }
+    type record = { foo : int; bar : int Atomic.t; baz : float }
   end in
-  let foo = 42 and bar = Atomic.make 101 in
-  let x = Multicore_magic.copy_as_padded { foo; bar } in
-  assert (x.foo = foo && x.bar == bar)
+  let foo = 42 and bar = Atomic.make 101 and baz = 9.6 in
+  let x = Multicore_magic.copy_as_padded { foo; bar; baz } in
+  assert (x.foo = foo && x.bar == bar && x.baz == baz)
 
 let can_pad_variants () =
   let open struct
@@ -38,6 +38,15 @@ let padded_array_length_minus_1 () =
       (Multicore_magic.make_padded_array 101 0)
     = 100)
 
+let can_pad_float_arrays () =
+  let x = 4.2 in
+  let xs = Multicore_magic.make_padded_array 5 x in
+  assert (5 <= Array.length xs);
+  for i = 0 to 4 do
+    assert (xs.(i) = x)
+  done;
+  assert (Multicore_magic.length_of_padded_array xs = 5)
+
 let fenceless_get () =
   assert (Multicore_magic.fenceless_get (Atomic.make 42) = 42)
 
@@ -65,6 +74,8 @@ let () =
         [ Alcotest.test_case "" `Quick padded_array_length ] );
       ( "padded array length - 1",
         [ Alcotest.test_case "" `Quick padded_array_length_minus_1 ] );
+      ( "can pad float arrays",
+        [ Alcotest.test_case "" `Quick can_pad_float_arrays ] );
       ("fenceless_get", [ Alcotest.test_case "" `Quick fenceless_get ]);
       ("fenceless_set", [ Alcotest.test_case "" `Quick fenceless_set ]);
       ("fence", [ Alcotest.test_case "" `Quick fence ]);