Merge pull request #9998 from lthls/afl-lazy

Prevent inlining of CamlinternalLazy.force

Changes

@@ -640,6 +640,12 @@ OCaml 4.12.0
   (Vincent Laviron, report by Stephen Dolan, review by Xavier Leroy and
   Stephen Dolan)
 
+- #9998: Use Sys.opaque_identity in CamlinternalLazy.force
+  This removes extra warning 59 messages when compiling afl-instrumented
+  code with flambda -O3.
+  (Vincent Laviron, report by Louis Gesbert, review by Gabriel Scherer and
+   Pierre Chambart)
+
 - #9999: fix -dsource printing of the pattern (`A as x | (`B as x)).
   (Gabriel Scherer, report by Anton Bachin, review by Florian Angeletti)
 

stdlib/.depend

@@ -137,9 +137,11 @@ camlinternalFormatBasics.cmx : \
     camlinternalFormatBasics.cmi
 camlinternalFormatBasics.cmi :
 camlinternalLazy.cmo : \
+    stdlib__sys.cmi \
     stdlib__obj.cmi \
     camlinternalLazy.cmi
 camlinternalLazy.cmx : \
+    stdlib__sys.cmx \
     stdlib__obj.cmx \
     camlinternalLazy.cmi
 camlinternalLazy.cmi :

stdlib/camlinternalLazy.ml

@@ -46,10 +46,18 @@ let force_val_lazy_block (blk : 'arg lazy_t) =
 
 
 (* [force] is not used, since [Lazy.force] is declared as a primitive
-   whose code inlines the tag tests of its argument.  This function is
-   here for the sake of completeness, and for debugging purpose. *)
+   whose code inlines the tag tests of its argument, except when afl
+   instrumentation is turned on. *)
 
 let force (lzv : 'arg lazy_t) =
+  (* Using [Sys.opaque_identity] prevents two potential problems:
+     - If the value is known to have Forward_tag, then its tag could have
+       changed during GC, so that information must be forgotten (see GPR#713
+       and issue #7301)
+     - If the value is known to be immutable, then if the compiler
+       cannot prove that the last branch is not taken it will issue a
+       warning 59 (modification of an immutable value) *)
+  let lzv = Sys.opaque_identity lzv in
   let x = Obj.repr lzv in
   let t = Obj.tag x in
   if t = Obj.forward_tag then (Obj.obj (Obj.field x 0) : 'arg) else

testsuite/tests/flambda/afl_lazy.ml

@@ -0,0 +1,11 @@
+(* TEST
+   * flambda
+   ** native
+   ocamlopt_flags = "-O3 -afl-instrument"
+*)
+
+let f l =
+  Lazy.force l
+
+let _ =
+  Sys.opaque_identity (f (lazy "Hello"))