Skip to content

Disable mixed blocks in extensible variants #2652

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
83 changes: 9 additions & 74 deletions ocaml/testsuite/tests/mixed-blocks/constructor_args.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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;
;;
Expand Down Expand Up @@ -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"]
Expand Down Expand Up @@ -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 +.
Expand All @@ -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;
;;

(**************************)
Expand Down
9 changes: 4 additions & 5 deletions ocaml/testsuite/tests/mixed-blocks/constructor_args.reference
Original file line number Diff line number Diff line change
@@ -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
Expand Down
15 changes: 12 additions & 3 deletions ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 = ..
Expand All @@ -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 *)
Expand Down
17 changes: 14 additions & 3 deletions ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 = ..
Expand All @@ -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 *)
Expand Down
9 changes: 3 additions & 6 deletions ocaml/testsuite/tests/typing-layouts-float32/basics.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 = ..
Expand All @@ -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.
|}]

(***************************************)
Expand Down
15 changes: 12 additions & 3 deletions ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 = ..
Expand All @@ -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;;
Expand Down
11 changes: 5 additions & 6 deletions ocaml/testsuite/tests/typing-layouts-float64/basics.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 = ..
Expand All @@ -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 = ..
Expand All @@ -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. *)
Expand Down
17 changes: 14 additions & 3 deletions ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 = ..
Expand All @@ -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. *)
Expand Down
Loading
Loading