Disable mixed blocks in extensible variants (#2652)

Author: ncik-roberts

ocaml/testsuite/tests/mixed-blocks/constructor_args.ml

@@ -43,21 +43,6 @@ type t =
   | Mixed11 of float * int32# * float32# * float# * int64# * nativeint#
   | Uniform2 of float * float
 
-type t_ext = ..
-
-type t_ext +=
-  | Ext_mixed1 of float#
-  | Ext_mixed2 of float * float#
-  | Ext_mixed3 of float * float# * float#
-  | Ext_mixed4 of float * float# * int32#
-  | Ext_mixed5 of float * float# * int * int32# * nativeint# * int64#
-  | Ext_mixed6 of float * int32# * float#
-  | Ext_mixed7 of float * int64# * float# * nativeint#
-  | Ext_mixed8 of float * int32# * float# * int64# * float#
-  | Ext_mixed9 of float * float# * float32#
-  | Ext_mixed10 of float * float32# * float# * int64# * float#
-  | Ext_mixed11 of float * int32# * float32# * float# * int64# * nativeint#
-
 let sprintf = Printf.sprintf
 
 let to_string = function
@@ -98,57 +83,18 @@ let to_string = function
         (Float_u.to_float x4) (Int64_u.to_int x5) (Nativeint_u.to_int x6)
   | Uniform2 (x1, x2) -> sprintf "Uniform2 (%f, %f)" x1 x2
 
-let ext_to_string = function
-  | Ext_mixed1 x -> sprintf "Ext_mixed1 %f" (Float_u.to_float x)
-  | Ext_mixed2 (x1, x2) -> sprintf "Ext_mixed2 (%f, %f)" x1 (Float_u.to_float x2)
-  | Ext_mixed3 (x1, x2, x3) ->
-    sprintf "Ext_mixed3 (%f, %f, %f)"
-      x1 (Float_u.to_float x2) (Float_u.to_float x3)
-  | Ext_mixed4 (x1, x2, x3) ->
-    sprintf "Ext_mixed4 (%f, %f, %i)"
-      x1 (Float_u.to_float x2) (Int32_u.to_int x3)
-  | Ext_mixed5 (x1, x2, x3, x4, x5, x6) ->
-    sprintf "Mixed5 (%f, %f, %i, %i, %i, %i)"
-      x1 (Float_u.to_float x2) x3 (Int32_u.to_int x4) (Nativeint_u.to_int x5)
-      (Int64_u.to_int x6)
-  | Ext_mixed6 (x1, x2, x3) ->
-    sprintf "Ext_mixed6 (%f, %i, %f)"
-      x1 (Int32_u.to_int x2) (Float_u.to_float x3)
-  | Ext_mixed7 (x1, x2, x3, x4) ->
-    sprintf "Ext_mixed7 (%f, %i, %f, %i)"
-      x1 (Int64_u.to_int x2) (Float_u.to_float x3) (Nativeint_u.to_int x4)
-  | Ext_mixed8 (x1, x2, x3, x4, x5) ->
-    sprintf "Ext_mixed8 (%f, %i, %f, %i, %f)"
-      x1 (Int32_u.to_int x2) (Float_u.to_float x3) (Int64_u.to_int x4)
-      (Float_u.to_float x5)
-  | Ext_mixed9 (x1, x2, x3) ->
-      sprintf "Ext_mixed9 (%f, %f, %f)" x1 (Float_u.to_float x2)
-      (Float_u.to_float (Float32_u.to_float x3))
-  | Ext_mixed10 (x1, x2, x3, x4, x5) ->
-      sprintf "Ext_mixed10 (%f, %f, %f, %i, %f)"
-        x1 (Float_u.to_float (Float32_u.to_float x2)) (Float_u.to_float x3)
-        (Int64_u.to_int x4) (Float_u.to_float x5)
-  | Ext_mixed11 (x1, x2, x3, x4, x5, x6) ->
-      sprintf "Ext_mixed11 (%f, %i, %f, %f, %i, %i)"
-        x1 (Int32_u.to_int x2) (Float_u.to_float (Float32_u.to_float x3))
-        (Float_u.to_float x4) (Int64_u.to_int x5) (Nativeint_u.to_int x6)
-  | _ -> "<ext>"
-
 let print t = print_endline ("  " ^ to_string t)
-let print_ext t = print_endline ("  " ^ ext_to_string t)
 
 (**********************)
 (* Test: construction *)
 
 let toplevel = Mixed1 #7.0
-let toplevel_ext = Ext_mixed1 #8.0
 
 let run f =
   print_endline "Test (construction)";
   let lit = Mixed2 (3.0, #4.5) in
   let half_lit = Mixed3 (6.0, f, #5.0) in
   print toplevel;
-  print_ext toplevel_ext;
   print lit;
   print half_lit;
 ;;
@@ -179,17 +125,6 @@ let construct_and_destruct uf uf' f f' i i32 i64 i_n f32 =
   let Mixed9 (f, uf, f32) = Mixed9 (f, uf, f32) in
   let Mixed10 (f, f32, uf, i64, uf') = Mixed10 (f, f32, uf, i64, uf') in
   let Mixed11 (f, i32, f32, uf, i64, i_n) = Mixed11 (f, i32, f32, uf, i64, i_n) in
-  let Ext_mixed1 uf = Ext_mixed1 uf in
-  let Ext_mixed2 (f, uf) = Ext_mixed2 (f, uf) in
-  let Ext_mixed3 (f, uf, uf') = Ext_mixed3 (f, uf, uf') in
-  let Ext_mixed4 (f, uf, i32) = Ext_mixed4 (f, uf, i32) in
-  let Ext_mixed5 (f, uf, i, i32, i_n, i64) = Ext_mixed5 (f, uf, i, i32, i_n, i64) in
-  let Ext_mixed6 (f, i32, uf) = Ext_mixed6 (f, i32, uf) in
-  let Ext_mixed7 (f, i64, uf, i_n) = Ext_mixed7 (f, i64, uf, i_n) in
-  let Ext_mixed8 (f, i32, uf, i64, uf') = Ext_mixed8 (f, i32, uf, i64, uf') in
-  let Ext_mixed9 (f, uf, f32) = Ext_mixed9 (f, uf, f32) in
-  let Ext_mixed10 (f, f32, uf, i64, uf') = Ext_mixed10 (f, f32, uf, i64, uf') in
-  let Ext_mixed11 (f, i32, f32, uf, i64, i_n) = Ext_mixed11 (f, i32, f32, uf, i64, i_n) in
   let Uniform2 (f, f') = Uniform2 (f, f') in
   sum uf uf' f f' i i32 i64 i_n f32
 [@@ocaml.warning "-partial-match"]
@@ -220,12 +155,12 @@ let () =
 (* Test: recursive groups *)
 
 let rec f r =
-  match r, t_rec1, t_rec2, t_ext_rec1, t_ext_rec2 with
+  match r, t_rec1, t_rec2, t_rec3, t_rec4 with
   | Mixed1 a,
     Mixed1 x,
     Mixed2 (y1, y2),
-    Ext_mixed1 z,
-    Ext_mixed2 (w1, w2) ->
+    Mixed1 z,
+    Mixed2 (w1, w2) ->
       Float_u.to_float x +.
       y1 +. Float_u.to_float y2 +.
       Float_u.to_float z +.
@@ -234,21 +169,21 @@ let rec f r =
 
 and t_rec1 = Mixed1 #4.0
 and t_rec2 = Mixed2 (5.0, #4.0)
-and t_ext_rec1 = Ext_mixed1 #5.0
-and t_ext_rec2 = Ext_mixed2 (6.0, #7.0)
+and t_rec3 = Mixed1 #5.0
+and t_rec4 = Mixed2 (6.0, #7.0)
 
 let _ =
   Printf.printf "Test (mixed constructors in recursive groups):\n";
   print t_rec1;
   print t_rec2;
-  print_ext t_ext_rec2;
-  print_ext t_ext_rec2;
+  print t_rec3;
+  print t_rec4;
   let result = f t_rec1 in
   print_float "  result (31.00)" result;
   print t_rec1;
   print t_rec2;
-  print_ext t_ext_rec2;
-  print_ext t_ext_rec2;
+  print t_rec3;
+  print t_rec4;
 ;;
 
 (**************************)

ocaml/testsuite/tests/mixed-blocks/constructor_args.reference

@@ -1,19 +1,18 @@
 Test (construction)
   Mixed1 7.000000
-  Ext_mixed1 8.000000
   Mixed2 (3.000000, 4.500000)
   Mixed3 (6.000000, 17.000000, 5.000000)
 Test (construct and destruct): 150.900000 = 150.900000 (PASS)
 Test (mixed constructors in recursive groups):
   Mixed1 4.000000
   Mixed2 (5.000000, 4.000000)
-  Ext_mixed2 (6.000000, 7.000000)
-  Ext_mixed2 (6.000000, 7.000000)
+  Mixed1 5.000000
+  Mixed2 (6.000000, 7.000000)
   result (31.00): 31.00
   Mixed1 4.000000
   Mixed2 (5.000000, 4.000000)
-  Ext_mixed2 (6.000000, 7.000000)
-  Ext_mixed2 (6.000000, 7.000000)
+  Mixed1 5.000000
+  Mixed2 (6.000000, 7.000000)
 Test (pattern matching).
   Contents of fields:
   4.000

ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml

@@ -71,12 +71,18 @@ type t11_1 = ..
 type t11_1 += A of t_bits32;;
 [%%expect{|
 type t11_1 = ..
-type t11_1 += A of t_bits32
+Line 3, characters 14-27:
+3 | type t11_1 += A of t_bits32;;
+                  ^^^^^^^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type t11_1 += B of int32#;;
 [%%expect{|
-type t11_1 += B of int32#
+Line 1, characters 14-25:
+1 | type t11_1 += B of int32#;;
+                  ^^^^^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type ('a : bits32) t11_2 = ..
@@ -88,7 +94,10 @@ type 'a t11_2 += B of 'a;;
 [%%expect{|
 type ('a : bits32) t11_2 = ..
 type 'a t11_2 += A of int
-type 'a t11_2 += B of 'a
+Line 5, characters 17-24:
+5 | type 'a t11_2 += B of 'a;;
+                     ^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 (* not allowed: value in flat suffix *)

ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml

@@ -68,18 +68,26 @@ Error: Expected all flat constructor arguments after non-value argument,
 (*****************************************************)
 (* Test 11: Allow bits64 in some extensible variants *)
 
+(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *)
+
 (* See [basics_alpha.ml] and [basics_beta.ml] for now *)
 type t11_1 = ..
 
 type t11_1 += A of t_bits64;;
 [%%expect{|
 type t11_1 = ..
-type t11_1 += A of t_bits64
+Line 3, characters 14-27:
+3 | type t11_1 += A of t_bits64;;
+                  ^^^^^^^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type t11_1 += B of int64#;;
 [%%expect{|
-type t11_1 += B of int64#
+Line 1, characters 14-25:
+1 | type t11_1 += B of int64#;;
+                  ^^^^^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type ('a : bits64) t11_2 = ..
@@ -91,7 +99,10 @@ type 'a t11_2 += B of 'a;;
 [%%expect{|
 type ('a : bits64) t11_2 = ..
 type 'a t11_2 += A of int
-type 'a t11_2 += B of 'a
+Line 5, characters 17-24:
+5 | type 'a t11_2 += B of 'a;;
+                     ^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 (* not allowed: value in flat suffix *)

ocaml/testsuite/tests/typing-layouts-float32/basics.ml

@@ -582,17 +582,15 @@ type t11_1 = ..
 Line 3, characters 14-28:
 3 | type t11_1 += A of t_float32;;
                   ^^^^^^^^^^^^^^
-Error: The enabled layouts extension does not allow for mixed constructors.
-       You must enable -extension layouts_beta to use this feature.
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type t11_1 += B of float32#;;
 [%%expect{|
 Line 1, characters 14-27:
 1 | type t11_1 += B of float32#;;
                   ^^^^^^^^^^^^^
-Error: The enabled layouts extension does not allow for mixed constructors.
-       You must enable -extension layouts_beta to use this feature.
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type ('a : float32) t11_2 = ..
@@ -607,8 +605,7 @@ type 'a t11_2 += A of int
 Line 5, characters 17-24:
 5 | type 'a t11_2 += B of 'a;;
                      ^^^^^^^
-Error: The enabled layouts extension does not allow for mixed constructors.
-       You must enable -extension layouts_beta to use this feature.
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 (***************************************)

ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml

@@ -560,12 +560,18 @@ type t11_1 = ..
 type t11_1 += A of t_float32;;
 [%%expect{|
 type t11_1 = ..
-type t11_1 += A of t_float32
+Line 3, characters 14-28:
+3 | type t11_1 += A of t_float32;;
+                  ^^^^^^^^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type t11_1 += B of float32#;;
 [%%expect{|
-type t11_1 += B of float32#
+Line 1, characters 14-27:
+1 | type t11_1 += B of float32#;;
+                  ^^^^^^^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type ('a : float32) t11_2 = ..
@@ -577,7 +583,10 @@ type 'a t11_2 += B of 'a;;
 [%%expect{|
 type ('a : float32) t11_2 = ..
 type 'a t11_2 += A of int
-type 'a t11_2 += B of 'a
+Line 5, characters 17-24:
+5 | type 'a t11_2 += B of 'a;;
+                     ^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type t11_1 += C of t_float32 * string;;

ocaml/testsuite/tests/typing-layouts-float64/basics.ml

@@ -573,6 +573,8 @@ Error: Don't know how to untag this type. Only int can be untagged.
 (******************************************************)
 (* Test 11: Allow float64 in some extensible variants *)
 
+(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *)
+
 (* Currently these are only supported in alpha *)
 
 type t11_1 = ..
@@ -583,17 +585,15 @@ type t11_1 = ..
 Line 3, characters 14-28:
 3 | type t11_1 += A of t_float64;;
                   ^^^^^^^^^^^^^^
-Error: The enabled layouts extension does not allow for mixed constructors.
-       You must enable -extension layouts_beta to use this feature.
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type t11_1 += B of float#;;
 [%%expect{|
 Line 1, characters 14-25:
 1 | type t11_1 += B of float#;;
                   ^^^^^^^^^^^
-Error: The enabled layouts extension does not allow for mixed constructors.
-       You must enable -extension layouts_beta to use this feature.
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type ('a : float64) t11_2 = ..
@@ -608,8 +608,7 @@ type 'a t11_2 += A of int
 Line 5, characters 17-24:
 5 | type 'a t11_2 += B of 'a;;
                      ^^^^^^^
-Error: The enabled layouts extension does not allow for mixed constructors.
-       You must enable -extension layouts_beta to use this feature.
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 (* Some extensible variants aren't supported, though. *)

ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml

@@ -560,19 +560,27 @@ Error: Don't know how to untag this type. Only int can be untagged.
 (******************************************************)
 (* Test 11: Allow float64 in some extensible variants *)
 
+(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *)
+
 (* Currently these are only supported in alpha *)
 
 type t11_1 = ..
 
 type t11_1 += A of t_float64;;
 [%%expect{|
 type t11_1 = ..
-type t11_1 += A of t_float64
+Line 3, characters 14-28:
+3 | type t11_1 += A of t_float64;;
+                  ^^^^^^^^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type t11_1 += B of float#;;
 [%%expect{|
-type t11_1 += B of float#
+Line 1, characters 14-25:
+1 | type t11_1 += B of float#;;
+                  ^^^^^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 type ('a : float64) t11_2 = ..
@@ -584,7 +592,10 @@ type 'a t11_2 += B of 'a;;
 [%%expect{|
 type ('a : float64) t11_2 = ..
 type 'a t11_2 += A of int
-type 'a t11_2 += B of 'a
+Line 5, characters 17-24:
+5 | type 'a t11_2 += B of 'a;;
+                     ^^^^^^^
+Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record.
 |}]
 
 (* Some extensible variants aren't supported, though. *)