diff options
-rw-r--r-- | Changes | 5 | ||||
-rw-r--r-- | runtime/alloc.c | 12 | ||||
-rw-r--r-- | testsuite/tests/letrec-compilation/pr12153_miscompilation_of_recursive_atoms.ml | 11 |
3 files changed, 27 insertions, 1 deletions
@@ -708,6 +708,11 @@ Working version - #12112: Fix caml_callback{2,3}_exn when used with effect handlers. (Lucas Pluvinage, review by Gabriel Scherer, David Allsopp and Xavier Leroy) +- #12153: Fix segfault in bytecode programs involving recursive value + definitions of values of size 0 + (Vincent Laviron, Xavier Leroy, Gabriel Scherer, + review by Xavier Leroy, report by Nick Roberts) + OCaml 5.0.0 (15 December 2022) ------------------------------ diff --git a/runtime/alloc.c b/runtime/alloc.c index 49188fb69f..94ab9db598 100644 --- a/runtime/alloc.c +++ b/runtime/alloc.c @@ -316,7 +316,17 @@ CAMLprim value caml_update_dummy(value dummy, value newval) tag = Tag_val (newval); - if (tag == Double_array_tag){ + if (Wosize_val(dummy) == 0) { + /* Size-0 blocks are statically-allocated atoms. We cannot + mutate them, but there is no need: + - All atoms used in the runtime to represent OCaml values + have tag 0 --- including empty flat float arrays, or other + types that use a non-0 tag for non-atom blocks. + - The dummy was already created with tag 0. + So doing nothing suffices. */ + CAMLassert(Wosize_val(newval) == 0); + CAMLassert(Tag_val(dummy) == Tag_val(newval)); + } else if (tag == Double_array_tag){ CAMLassert (Wosize_val(newval) == Wosize_val(dummy)); CAMLassert (Tag_val(dummy) != Infix_tag); Unsafe_store_tag_val(dummy, Double_array_tag); diff --git a/testsuite/tests/letrec-compilation/pr12153_miscompilation_of_recursive_atoms.ml b/testsuite/tests/letrec-compilation/pr12153_miscompilation_of_recursive_atoms.ml new file mode 100644 index 0000000000..10ca5d6ea4 --- /dev/null +++ b/testsuite/tests/letrec-compilation/pr12153_miscompilation_of_recursive_atoms.ml @@ -0,0 +1,11 @@ +(* TEST *) + +let rec empty_int_array : int array = + let _ = empty_int_array in [||] + +let rec empty_float_array : float array = + let _ = empty_float_array in [||] + +module type Empty = sig end +let rec empty_mod : (module Empty) = + let _ = empty_mod in (module struct end) |