diff --git a/runtime/roots_nat.c b/runtime/roots_nat.c index b7a24adc76e..8618d435d12 100644 --- a/runtime/roots_nat.c +++ b/runtime/roots_nat.c @@ -522,7 +522,7 @@ static void do_local_allocations(caml_local_arenas* loc, if (marked_local) { int ix = get_local_ix(loc, *p); struct caml_local_arena a = loc->arenas[ix]; - intnat newsp = (char*)p - (a.base + a.length); + intnat newsp = (char*)*p - (a.base + a.length); if (sp <= newsp) { /* forwards pointer, common case */ CAMLassert(ix <= arena_ix); diff --git a/testsuite/tests/typing-local/localgcbug.ml b/testsuite/tests/typing-local/localgcbug.ml new file mode 100644 index 00000000000..38b679d7d59 --- /dev/null +++ b/testsuite/tests/typing-local/localgcbug.ml @@ -0,0 +1,20 @@ +(* TEST + flags += "-extension local" + * native *) + +type n = Z | S of n + +let rec gen_locals (local_ n) depth _ = local_ + if depth = 0 + then + S n + else + let s = S n in + let m = gen_locals s (depth - 1) (ref 42) in + let _ = gen_locals m (depth - 1) (ref 42) in + S n + +let () = + match gen_locals Z 21 (ref 42) with + | S Z -> print_endline "ok" + | _ -> assert false diff --git a/testsuite/tests/typing-local/localgcbug.reference b/testsuite/tests/typing-local/localgcbug.reference new file mode 100644 index 00000000000..9766475a418 --- /dev/null +++ b/testsuite/tests/typing-local/localgcbug.reference @@ -0,0 +1 @@ +ok