Typemod: toplevel bindings escape even if no variables are bound

Author: stedolan

testsuite/tests/typing-local/local.ml

@@ -599,9 +599,19 @@ Line 1, characters 4-18:
 Error: This value escapes its region
 |}]
 
+module M = struct
+  let _ = local_ {contents=42}
+end
+[%%expect{|
+module M : sig end
+|}]
+
 let _ = local_ {contents=42}
 [%%expect{|
-- : int ref = {contents = 42}
+Line 1, characters 4-5:
+1 | let _ = local_ {contents=42}
+        ^
+Error: This value escapes its region
 |}]
 
 
@@ -1768,21 +1778,25 @@ let foo (local_ x) y =
 val foo : local_ 'a option -> 'a option -> local_ 'a = <fun>
 |}]
 
-let (Some z, _, _) | (None, Some z, _)
-    | (None, None, z) = (Some (ref 0), (local_ (Some (ref 0))), (ref 0))
+module M = struct
+  let (Some z, _, _) | (None, Some z, _)
+      | (None, None, z) = (Some (ref 0), (local_ (Some (ref 0))), (ref 0))
+end
 [%%expect{|
-Line 1, characters 33-34:
-1 | let (Some z, _, _) | (None, Some z, _)
-                                     ^
+Line 2, characters 35-36:
+2 |   let (Some z, _, _) | (None, Some z, _)
+                                       ^
 Error: This value escapes its region
 |}]
 
-let (Some z, _, _) | (None, Some z, _)
-    | (None, None, z) = ((local_ Some (ref 0)), (Some (ref 0)), (ref 0))
+module M = struct
+  let (Some z, _, _) | (None, Some z, _)
+      | (None, None, z) = ((local_ Some (ref 0)), (Some (ref 0)), (ref 0))
+end
 [%%expect{|
-Line 1, characters 10-11:
-1 | let (Some z, _, _) | (None, Some z, _)
-              ^
+Line 2, characters 12-13:
+2 |   let (Some z, _, _) | (None, Some z, _)
+                ^
 Error: This value escapes its region
 |}]
 

typing/typemod.ml

@@ -2169,6 +2169,12 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr =
         let () = if rec_flag = Recursive then
           Typecore.check_recursive_bindings env defs
         in
+        if toplevel then begin
+          (* Values bound by '_' still escape in the toplevel, because
+              they may be printed even though they are not named *)
+          defs |> List.iter (fun vb ->
+            Typecore.escape ~loc:vb.vb_pat.pat_loc ~env:newenv vb.vb_expr.exp_mode);
+        end;
         (* Note: Env.find_value does not trigger the value_used event. Values
            will be marked as being used during the signature inclusion test. *)
         Tstr_value(rec_flag, defs),