flambda-backend: Check for value in polymorphic variant argument (#1482)

Author: goldfirere

testsuite/tests/typing-layouts/basics.ml

@@ -305,3 +305,9 @@ Error: Layout void is used here, but the appropriate layouts extension is not en
 
 (* CR layouts: This test moves to [basics_alpha.ml] as it needs a non-value
    sort.  Bring back here when we have one enabled by default. *)
+
+(*********************************************************)
+(* Test 32: Polymorphic variant constructors take values *)
+
+(* CR layouts: This test moves to [basics_alpha.ml] as it needs a non-value
+   sort.  Bring back here when we have one enabled by default. *)

testsuite/tests/typing-layouts/basics_alpha.ml

@@ -1462,3 +1462,17 @@ Error: This type ('a : value) should be an instance of type ('a0 : void)
    the type definition if we're not allowing `void` things in structures).
    This bug is a goof at the top of Typecore.build_or_pat;
    there is another CR layouts there. *)
+
+(*********************************************************)
+(* Test 32: Polymorphic variant constructors take values *)
+
+let f _ = `Mk (assert false : t_void)
+
+[%%expect{|
+Line 1, characters 14-37:
+1 | let f _ = `Mk (assert false : t_void)
+                  ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type t_void but an expression was expected of type
+         ('a : value)
+       t_void has layout void, which is not a sublayout of value.
+|}]

testsuite/tests/typing-layouts/basics_beta.ml

@@ -511,3 +511,9 @@ Error: Layout void is used here, but the appropriate layouts extension is not en
 
 (* CR layouts: This test moves to [basics_alpha.ml] as it needs a non-value
    sort.  Bring back here when we have one. *)
+
+(*********************************************************)
+(* Test 32: Polymorphic variant constructors take values *)
+
+(* CR layouts: This test moves to [basics_alpha.ml] as it needs a non-value
+   sort.  Bring back here when we have one. *)

typing/typecore.ml

@@ -4557,7 +4557,12 @@ and type_expect_
         let arg = match sarg with
         | None -> None
         | Some sarg ->
-            let arg = type_exp env argument_mode sarg in
+            let ty_expected =
+              newvar (Layout.value ~why:Polymorphic_variant_field)
+            in
+            let arg =
+              type_expect env argument_mode sarg (mk_expected ty_expected)
+            in
             let alloc_mode = register_allocation expected_mode in
             Some (arg, alloc_mode)
         in