Skip to content

Commit

Permalink
Fix to not cause segfault on float arrays
Browse files Browse the repository at this point in the history
  • Loading branch information
polytypic committed Jul 28, 2023
1 parent f2cec96 commit b4f876b
Show file tree
Hide file tree
Showing 2 changed files with 18 additions and 6 deletions.
5 changes: 3 additions & 2 deletions src/Multicore_magic.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
19 changes: 15 additions & 4 deletions test/Multicore_magic_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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 ]);
Expand Down

0 comments on commit b4f876b

Please sign in to comment.