Fix Weak.get_copy not darkening custom blocks

[jberdine]

This PR changes ephe_get_field_copy to darken the value it returns if it is a custom block.

While looking at PRs related to ephemerons I noticed a suspicious code path in ephe_get_field_copy. So far I have not managed to trigger a crash, but figured I would send this PR for feedback anyhow.

The scenario that worries me is if ephe_get_field_copy is called with a value that is not caml_ephe_none and is a custom block. In this case, a Some block will be allocated to wrap it, and returned. So the argument custom block value will be returned without being copied nor darkened. If ephe_get_field were called, it would be darkened. It makes sense that custom blocks are not copied, to avoid issues with calling finalizers multiple times. But I can not see how it is safe to not darken the returned value.

Looking at the history, when custom blocks stopped being copied, they were darkened: #710

Unrelated but in the same code, ephe_get_field_copy has a retry loop to protect against an allocation changing the tag or size of the value it is being asked to copy. Isn't changing tags or sizes no longer possible with the ocaml 5 runtime? But I'm unsure about Forward_tag values.

Signed-off-by: Josh Berdine josh@berdine.net

[stedolan]

Thanks, well spotted!

For concreteness, here's a program that hits the bug:

let w = Weak.create 1

let major_obj () =
  let n = Sys.opaque_identity 42 in
  let v = Int64.of_int n in
  Gc.minor ();
  v

let () =
  Weak.set w 0 (Some (major_obj ()));
  Gc.major ();
  let x = Option.get (Weak.get_copy w 0) in
  Gc.major ();
  Printf.printf "value: %Ld\n%!" x;
  let junk = List.init 1_000_000 Fun.id in
  Gc.minor ();
  ignore (Sys.opaque_identity junk);
  Printf.printf "value: %Ld\n%!" x

On my machine, I get:

value: 42
value: 139868630726576

where the second print is corrupted because the memory has been reused as a cons cell.

[gasche]

The regression test could make a good testsuite addition?

[gasche]

There is a CI failure on macos-arm64 on test_compact_manydomains:

2025-03-13T22:51:57.9502130Z Timeout expired, killing all child processes
2025-03-13T22:51:57.9502710Z Process 29515 got signal 9(Killed: 9), no core dumped
2025-03-13T22:51:57.9503560Z  ... testing 'test_compact_manydomains.ml' => failed
2025-03-13T22:51:57.9504680Z  ... testing 'test_compact_manydomains.ml' with default (native) => failed (Running program /Users/runner/work/ocaml/ocaml/testsuite/tests/compaction/_ocamltest/tests/compaction/test_compact_manydomains/ocamlopt.byte/test_compact_manydomains.opt without any argument: command
2025-03-13T22:51:57.9507160Z /Users/runner/work/ocaml/ocaml/testsuite/tests/compaction/_ocamltest/tests/compaction/test_compact_manydomains/ocamlopt.byte/test_compact_manydomains.opt 
2025-03-13T22:51:57.9508110Z failed with exit code -9)

I think that this is unrelated to the current PR -- the test is too time-consuming and times out on the CI machine -- and not a weird infinite loop that you introduced and only occurs in native and not in bytecode. I re-ran the job just to make sure.