Turn upstream compatibility errors into a warning

ocaml/testsuite/tests/typing-layouts/erasable_annot.ml

@@ -75,12 +75,6 @@ Line 1, characters 4-5:
 Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
 can't be erased for compatibility with upstream OCaml.
 
-Line 1, characters 6-47:
-1 | let f (type a : immediate): a -> a = fun x -> x
-          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
-can't be erased for compatibility with upstream OCaml.
-
 val f : ('a : immediate). 'a -> 'a = <fun>
 |}];;
 
@@ -92,12 +86,6 @@ Line 1, characters 4-5:
 Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
 can't be erased for compatibility with upstream OCaml.
 
-Line 1, characters 6-31:
-1 | let f x = (x : (_ : immediate))
-          ^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
-can't be erased for compatibility with upstream OCaml.
-
 val f : ('a : immediate). 'a -> 'a = <fun>
 |}];;
 
@@ -109,12 +97,6 @@ Line 1, characters 4-5:
 Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
 can't be erased for compatibility with upstream OCaml.
 
-Line 1, characters 6-63:
-1 | let f v: ((_ : immediate)[@error_message "Custom message"]) = v
-          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
-can't be erased for compatibility with upstream OCaml.
-
 val f : ('a : immediate). 'a -> 'a = <fun>
 |}];;
 
@@ -181,12 +163,6 @@ Line 1, characters 4-5:
 Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
 can't be erased for compatibility with upstream OCaml.
 
-Line 1, characters 6-49:
-1 | let f (type a : immediate64): a -> a = fun x -> x
-          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
-can't be erased for compatibility with upstream OCaml.
-
 val f : ('a : immediate64). 'a -> 'a = <fun>
 |}];;
 
@@ -198,12 +174,6 @@ Line 1, characters 4-5:
 Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
 can't be erased for compatibility with upstream OCaml.
 
-Line 1, characters 6-33:
-1 | let f x = (x : (_ : immediate64))
-          ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
-can't be erased for compatibility with upstream OCaml.
-
 val f : ('a : immediate64). 'a -> 'a = <fun>
 |}];;
 
@@ -215,12 +185,6 @@ Line 1, characters 4-5:
 Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
 can't be erased for compatibility with upstream OCaml.
 
-Line 1, characters 6-65:
-1 | let f v: ((_ : immediate64)[@error_message "Custom message"]) = v
-          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 187 [incompatible-with-upstream]: Usage of layout immediate/immediate64 in f
-can't be erased for compatibility with upstream OCaml.
-
 val f : ('a : immediate64). 'a -> 'a = <fun>
 |}];;
 

ocaml/typing/ctype.ml

@@ -2302,7 +2302,7 @@ let unification_jkind_check env ty jkind =
   | Delay_checks r -> r := (ty,jkind) :: !r
   | Skip_checks -> ()
 
-let check_and_update_generalized_ty_jkind ?name ~loc ty =
+let check_and_update_generalized_ty_jkind ?name ~loc ~upstream_compat ty =
   let immediacy_check jkind =
     let is_immediate jkind =
       (* Just check externality and layout, because that's what actually matters
@@ -2314,7 +2314,7 @@ let check_and_update_generalized_ty_jkind ?name ~loc ty =
                | _ -> false)
     in
     if Language_extension.erasable_extensions_only ()
-      && is_immediate jkind
+      && is_immediate jkind && upstream_compat
     then
       let id =
         match name with

ocaml/typing/ctype.mli

@@ -617,7 +617,7 @@ val check_type_externality : Env.t -> type_expr -> Jkind.Externality.t -> bool
 
    *)
 val check_and_update_generalized_ty_jkind :
-  ?name:Ident.t -> loc:Location.t -> type_expr -> unit
+  ?name:Ident.t -> loc:Location.t -> upstream_compat:bool -> type_expr -> unit
 
 (* False if running in principal mode and the type is not principal.
    True otherwise. *)

ocaml/typing/typecore.ml

@@ -8472,7 +8472,7 @@ and type_let ?check ?check_strict ?(force_toplevel = false)
       List.iter
         (fun pv ->
           Ctype.check_and_update_generalized_ty_jkind
-            ~name:pv.pv_id ~loc:pv.pv_loc pv.pv_type)
+            ~name:pv.pv_id ~loc:pv.pv_loc ~upstream_compat:true pv.pv_type)
         pvs;
       List.iter2
         (fun (_, _, expected_ty) (exp, vars) ->
@@ -8500,8 +8500,10 @@ and type_let ?check ?check_strict ?(force_toplevel = false)
             Tpat_var (id, _, _, _) -> Some id
           | Tpat_alias(_, id, _, _, _) -> Some id
           | _ -> None in
+        (* We don't need to check upstream compatibility for expressions:
+           just ensuring that annotations are erasable is enough. *)
         Ctype.check_and_update_generalized_ty_jkind
-          ?name:pat_name ~loc:exp.exp_loc exp.exp_type
+          ?name:pat_name ~loc:exp.exp_loc ~upstream_compat:false exp.exp_type
       in
       List.iter2 update_exp_jkind mode_pat_typ_list exp_list;
     end

ocaml/typing/typedecl.ml

@@ -1575,7 +1575,7 @@ let update_decls_jkind_reason decls =
     (fun (id, decl) ->
        let update_generalized =
         Ctype.check_and_update_generalized_ty_jkind
-          ~name:id ~loc:decl.type_loc
+          ~name:id ~loc:decl.type_loc ~upstream_compat:true
        in
        List.iter update_generalized decl.type_params;
        Btype.iter_type_expr_kind update_generalized decl.type_kind;
@@ -2917,7 +2917,8 @@ let transl_value_decl env loc valdecl =
     Env.enter_value valdecl.pval_name.txt v env
       ~check:(fun s -> Warnings.Unused_value_declaration s)
   in
-  Ctype.check_and_update_generalized_ty_jkind ~name:id ~loc ty;
+  Ctype.check_and_update_generalized_ty_jkind
+    ~name:id ~loc ~upstream_compat:true ty;
   let desc =
     {
      val_id = id;