diff options
| author | Gabriel Scherer <gabriel.scherer@gmail.com> | 2023-04-01 16:00:28 +0200 |
|---|---|---|
| committer | Gabriel Scherer <gabriel.scherer@gmail.com> | 2023-04-01 22:41:12 +0200 |
| commit | 85929b2350f01a2a4c1110b43cf02e6da07cfb89 (patch) | |
| tree | 1b821696adf42da5de195eb7326b9a26f57af108 | |
| parent | be27ba829f5eafb6abf9e5d91a78ea5403d52782 (diff) | |
| download | ocaml-85929b2350f01a2a4c1110b43cf02e6da07cfb89.tar.gz | |
caml_update_dummy: do not try to update size-0 atoms
fixes #12153
Suggested-by: Xavier Leroy <xavier.leroy@college-de-france.fr>
Suggested-by: Vincent Laviron <vincent.laviron@gmail.com>
Reported-by: Nick Roberts <nroberts@janestreet.com>
| -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) |