diff --git a/ocaml/testsuite/tests/typing-layouts-bits32/basics.ml b/ocaml/testsuite/tests/typing-layouts-bits32/basics.ml index 4515cf17624..f6784f1be0d 100644 --- a/ocaml/testsuite/tests/typing-layouts-bits32/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-bits32/basics.ml @@ -202,10 +202,20 @@ Error: This type ('b : value) should be an instance of type ('a : bits32) (*********************************************************) (* Test 5: Allowed in some structures in typedecls. *) -(* For the structures they can be put in, see [basics_alpha.ml]. - They're separate because mixed blocks requires alpha at the - moment. - *) +type t5_1 = { x : t_bits32 };; +[%%expect{| +type t5_1 = { x : t_bits32; } +|}];; + +type t5_2 = { y : int; x : t_bits32 };; +[%%expect{| +type t5_2 = { y : int; x : t_bits32; } +|}];; + +type t5_2' = { y : string; x : t_bits32 };; +[%%expect{| +type t5_2' = { y : string; x : t_bits32; } +|}];; (* CR layouts 2.5: allow this *) type t5_3 = { x : t_bits32 } [@@unboxed];; @@ -217,6 +227,35 @@ Error: Type t_bits32 has layout bits32. Unboxed records may not yet contain types of this layout. |}];; + +type t5_4 = A of t_bits32;; +[%%expect{| +type t5_4 = A of t_bits32 +|}];; + +type t5_5 = A of int * t_bits32;; +[%%expect{| +type t5_5 = A of int * t_bits32 +|}];; + +type ('a : bits32) t5_7 = A of int +type ('a : bits32) t5_8 = A of 'a;; +[%%expect{| +type ('a : bits32) t5_7 = A of int +type ('a : bits32) t5_8 = A of 'a +|}] + +(* not allowed: value in flat suffix *) +type 'a t_disallowed = A of t_bits32 * 'a + +[%%expect{| +Line 1, characters 23-41: +1 | type 'a t_disallowed = A of t_bits32 * 'a + ^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, + t_bits32, but found boxed argument, 'a. +|}] + type t5_6 = A of t_bits32 [@@unboxed];; [%%expect{| Line 1, characters 12-25: @@ -464,12 +503,54 @@ Line 1, characters 29-35: Error: Don't know how to untag this type. Only int can be untagged. |}];; -(*******************************************************) -(* Test 11: Allow bits32 in some extensible variants *) +(*************************************************) +(* Test 11: bits32 banned in extensible variants *) + +type t11_1 = .. + +type t11_1 += A of t_bits32;; +[%%expect{| +type t11_1 = .. +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{| +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 = .. + +type 'a t11_2 += A of int + +type 'a t11_2 += B of 'a;; + +[%%expect{| +type ('a : bits32) t11_2 = .. +type 'a t11_2 += A of int +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 *) +type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + +[%%expect{| +Line 1, characters 17-40: +1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + ^^^^^^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, 'a, + but found boxed argument, 'b. +|}] -(* See [basics_alpha.ml] for these while mixed blocks are - in alpha. -*) (***************************************) (* Test 12: bits32 in objects/classes *) diff --git a/ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml deleted file mode 100644 index 6996c65134d..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml +++ /dev/null @@ -1,112 +0,0 @@ -(* TEST - { - flags = "-extension layouts_alpha"; - expect; - }{ - flags = "-extension layouts_beta"; - expect; - } -*) - -(* We should move these back into [basics.ml] once - mixed blocks are out of beta. *) - -type t_bits32 : bits32 -type ('a : bits32) t_bits32_id = 'a - -[%%expect{| -type t_bits32 : bits32 -type ('a : bits32) t_bits32_id = 'a -|}];; - -(* Test 5: structures *) - -type t5_1 = { x : t_bits32 };; -[%%expect{| -type t5_1 = { x : t_bits32; } -|}];; - -type t5_2 = { y : int; x : t_bits32 };; -[%%expect{| -type t5_2 = { y : int; x : t_bits32; } -|}];; - -type t5_2' = { y : string; x : t_bits32 };; -[%%expect{| -type t5_2' = { y : string; x : t_bits32; } -|}];; - -type t5_4 = A of t_bits32;; -[%%expect{| -type t5_4 = A of t_bits32 -|}];; - -type t5_5 = A of int * t_bits32;; -[%%expect{| -type t5_5 = A of int * t_bits32 -|}];; - -type ('a : bits32) t5_7 = A of int -type ('a : bits32) t5_8 = A of 'a;; -[%%expect{| -type ('a : bits32) t5_7 = A of int -type ('a : bits32) t5_8 = A of 'a -|}] - -(* not allowed: value in flat suffix *) -type 'a t_disallowed = A of t_bits32 * 'a - -[%%expect{| -Line 1, characters 23-41: -1 | type 'a t_disallowed = A of t_bits32 * 'a - ^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - t_bits32, but found boxed argument, 'a. -|}] - -(* Test 11: Extensible variants *) - -type t11_1 = .. - -type t11_1 += A of t_bits32;; -[%%expect{| -type t11_1 = .. -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{| -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 = .. - -type 'a t11_2 += A of int - -type 'a t11_2 += B of 'a;; - -[%%expect{| -type ('a : bits32) t11_2 = .. -type 'a t11_2 += A of int -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 *) -type 'a t11_2 += C : 'a * 'b -> 'a t11_2 - -[%%expect{| -Line 1, characters 17-40: -1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 - ^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, 'a, - but found boxed argument, 'b. -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-bits32/parsing.ml b/ocaml/testsuite/tests/typing-layouts-bits32/parsing.ml index 153f018a022..adc76124666 100644 --- a/ocaml/testsuite/tests/typing-layouts-bits32/parsing.ml +++ b/ocaml/testsuite/tests/typing-layouts-bits32/parsing.ml @@ -16,20 +16,12 @@ val f : int32# -> unit = type t = C of int32#;; [%%expect {| -Line 1, characters 9-20: -1 | type t = C of int32#;; - ^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t = C of int32# |}];; type t = C : int32# -> t;; [%%expect {| -Line 1, characters 9-24: -1 | type t = C : int32# -> t;; - ^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t = C : int32# -> t |}];; (* int32# works as an argument to normal type constructors, not just diff --git a/ocaml/testsuite/tests/typing-layouts-bits64/basics.ml b/ocaml/testsuite/tests/typing-layouts-bits64/basics.ml index ca44b20bdb7..928a87135c7 100644 --- a/ocaml/testsuite/tests/typing-layouts-bits64/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-bits64/basics.ml @@ -202,7 +202,20 @@ Error: This type ('b : value) should be an instance of type ('a : bits64) (****************************************************) (* Test 5: Allowed in some structures in typedecls. *) -(* See [basics_alpha.ml] and [basics_beta.ml] for now *) +type t5_1 = { x : t_bits64 };; +[%%expect{| +type t5_1 = { x : t_bits64; } +|}];; + +type t5_2 = { y : int; x : t_bits64 };; +[%%expect{| +type t5_2 = { y : int; x : t_bits64; } +|}];; + +type t5_2' = { y : string; x : t_bits64 };; +[%%expect{| +type t5_2' = { y : string; x : t_bits64; } +|}];; (* CR layouts 2.5: allow this *) type t5_3 = { x : t_bits64 } [@@unboxed];; @@ -214,6 +227,35 @@ Error: Type t_bits64 has layout bits64. Unboxed records may not yet contain types of this layout. |}];; +type t5_4 = A of t_bits64;; +[%%expect{| +type t5_4 = A of t_bits64 +|}];; + +type t5_5 = A of int * t_bits64;; +[%%expect{| +type t5_5 = A of int * t_bits64 +|}];; + +type ('a : bits64) t5_7 = A of int +type ('a : bits64) t5_8 = A of 'a;; +[%%expect{| +type ('a : bits64) t5_7 = A of int +type ('a : bits64) t5_8 = A of 'a +|}] + +(* not allowed: value in flat suffix *) +type 'a t_disallowed = A of t_bits64 * 'a + +[%%expect{| +Line 1, characters 23-41: +1 | type 'a t_disallowed = A of t_bits64 * 'a + ^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, + t_bits64, but found boxed argument, 'a. +|}] + + type t5_6 = A of t_bits64 [@@unboxed];; [%%expect{| Line 1, characters 12-25: @@ -461,10 +503,55 @@ Line 1, characters 29-35: Error: Don't know how to untag this type. Only int can be untagged. |}];; -(*****************************************************) -(* Test 11: Allow bits64 in some extensible variants *) +(*************************************************) +(* Test 11: bits64 banned in extensible variants *) + +(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) + +type t11_1 = .. + +type t11_1 += A of t_bits64;; +[%%expect{| +type t11_1 = .. +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{| +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. +|}] -(* See [basics_alpha.ml] and [basics_beta.ml] for now *) +type ('a : bits64) t11_2 = .. + +type 'a t11_2 += A of int + +type 'a t11_2 += B of 'a;; + +[%%expect{| +type ('a : bits64) t11_2 = .. +type 'a t11_2 += A of int +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 *) +type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + +[%%expect{| +Line 1, characters 17-40: +1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + ^^^^^^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, 'a, + but found boxed argument, 'b. +|}] (***************************************) (* Test 12: bits64 in objects/classes *) diff --git a/ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml deleted file mode 100644 index 606e84552f0..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml +++ /dev/null @@ -1,117 +0,0 @@ -(* TEST - { - flags = "-extension layouts_alpha"; - expect; - }{ - flags = "-extension layouts_beta"; - expect; - } -*) - -(* We should move these back into [basics.ml] once - mixed blocks are out of beta. *) - -type t_bits64 : bits64 -type ('a : bits64) t_bits64_id = 'a - -[%%expect{| -type t_bits64 : bits64 -type ('a : bits64) t_bits64_id = 'a -|}];; - -(****************************************************) -(* Test 5: Allowed in some structures in typedecls. *) - -type t5_1 = { x : t_bits64 };; -[%%expect{| -type t5_1 = { x : t_bits64; } -|}];; - -type t5_2 = { y : int; x : t_bits64 };; -[%%expect{| -type t5_2 = { y : int; x : t_bits64; } -|}];; - -type t5_2' = { y : string; x : t_bits64 };; -[%%expect{| -type t5_2' = { y : string; x : t_bits64; } -|}];; - -type t5_4 = A of t_bits64;; -[%%expect{| -type t5_4 = A of t_bits64 -|}];; - -type t5_5 = A of int * t_bits64;; -[%%expect{| -type t5_5 = A of int * t_bits64 -|}];; - -type ('a : bits64) t5_7 = A of int -type ('a : bits64) t5_8 = A of 'a;; -[%%expect{| -type ('a : bits64) t5_7 = A of int -type ('a : bits64) t5_8 = A of 'a -|}] - -(* not allowed: value in flat suffix *) -type 'a t_disallowed = A of t_bits64 * 'a - -[%%expect{| -Line 1, characters 23-41: -1 | type 'a t_disallowed = A of t_bits64 * 'a - ^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - t_bits64, but found boxed argument, 'a. -|}] - -(*****************************************************) -(* 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 = .. -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{| -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 = .. - -type 'a t11_2 += A of int - -type 'a t11_2 += B of 'a;; - -[%%expect{| -type ('a : bits64) t11_2 = .. -type 'a t11_2 += A of int -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 *) -type 'a t11_2 += C : 'a * 'b -> 'a t11_2 - -[%%expect{| -Line 1, characters 17-40: -1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 - ^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, 'a, - but found boxed argument, 'b. -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-bits64/parsing.ml b/ocaml/testsuite/tests/typing-layouts-bits64/parsing.ml index 2c650a91404..07107fc0cc3 100644 --- a/ocaml/testsuite/tests/typing-layouts-bits64/parsing.ml +++ b/ocaml/testsuite/tests/typing-layouts-bits64/parsing.ml @@ -16,20 +16,12 @@ val f : int64# -> unit = type t = C of int64#;; [%%expect {| -Line 1, characters 9-20: -1 | type t = C of int64#;; - ^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t = C of int64# |}];; type t = C : int64# -> t;; [%%expect {| -Line 1, characters 9-24: -1 | type t = C : int64# -> t;; - ^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t = C : int64# -> t |}];; (* int64# works as an argument to normal type constructors, not just diff --git a/ocaml/testsuite/tests/typing-layouts-float32/basics.ml b/ocaml/testsuite/tests/typing-layouts-float32/basics.ml index 26d901540ff..9ba665980e8 100644 --- a/ocaml/testsuite/tests/typing-layouts-float32/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-float32/basics.ml @@ -202,11 +202,7 @@ Error: This type ('b : value) should be an instance of type ('a : float32) records. *) type t5_1 = { x : t_float32 };; [%%expect{| -Line 1, characters 0-29: -1 | type t5_1 = { x : t_float32 };; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type t5_1 = { x : t_float32; } |}];; (* CR layouts 2.5: allow this *) @@ -221,20 +217,12 @@ Error: Type t_float32 has layout float32. type t5_4 = A of t_float32;; [%%expect{| -Line 1, characters 12-26: -1 | type t5_4 = 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. +type t5_4 = A of t_float32 |}];; type t5_5 = A of int * t_float32;; [%%expect{| -Line 1, characters 12-32: -1 | type t5_5 = A of int * t_float32;; - ^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t5_5 = A of int * t_float32 |}];; type t5_6 = A of t_float32 [@@unboxed];; @@ -250,11 +238,7 @@ type ('a : float32) t5_7 = A of int type ('a : float32) t5_8 = A of 'a;; [%%expect{| type ('a : float32) t5_7 = A of int -Line 2, characters 27-34: -2 | type ('a : float32) t5_8 = A of 'a;; - ^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type ('a : float32) t5_8 = A of 'a |}] type ('a : float32, 'b : float32) t5_9 = {x : 'a; y : 'b; z : 'a} @@ -262,48 +246,41 @@ type ('a : float32, 'b : float32) t5_9 = {x : 'a; y : 'b; z : 'a} type 'a t5_10 = 'a t_float32_id and 'a t5_11 = {x : 'a t5_10; y : 'a} [%%expect{| -Line 1, characters 0-65: -1 | type ('a : float32, 'b : float32) t5_9 = {x : 'a; y : 'b; z : 'a} - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type ('a : float32, 'b : float32) t5_9 = { x : 'a; y : 'b; z : 'a; } +Line 4, characters 20-28: +4 | and 'a t5_11 = {x : 'a t5_10; y : 'a} + ^^^^^^^^ +Error: Layout mismatch in final type declaration consistency check. + This is most often caused by the fact that type inference is not + clever enough to propagate layouts through variables in different + declarations. It is also not clever enough to produce a good error + message, so we'll say this instead: + The layout of 'a is float32, because + of the definition of t_float32_id at line 2, characters 0-37. + But the layout of 'a must overlap with value, because + it instantiates an unannotated type parameter of t5_11, defaulted to layout value. + A good next step is to add a layout annotation on a parameter to + the declaration where this error is reported. |}];; type ('a : float32) t5_12 = {x : 'a; y : float32#};; [%%expect{| -Line 1, characters 0-50: -1 | type ('a : float32) t5_12 = {x : 'a; y : float32#};; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type ('a : float32) t5_12 = { x : 'a; y : float32#; } |}];; type ('a : float32) t5_13 = {x : 'a; y : float32#};; [%%expect{| -Line 1, characters 0-50: -1 | type ('a : float32) t5_13 = {x : 'a; y : float32#};; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type ('a : float32) t5_13 = { x : 'a; y : float32#; } |}];; -(* Mixed records are allowed, but are prohibited outside of alpha. *) type 'a t5_14 = {x : 'a; y : float32#};; [%%expect{| -Line 1, characters 0-38: -1 | type 'a t5_14 = {x : 'a; y : float32#};; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type 'a t5_14 = { x : 'a; y : float32#; } |}];; type ufref = { mutable contents : float32# };; [%%expect{| -Line 1, characters 0-44: -1 | type ufref = { mutable contents : float32# };; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type ufref = { mutable contents : float32#; } |}];; (****************************************************) @@ -571,8 +548,8 @@ Line 1, characters 29-37: Error: Don't know how to untag this type. Only int can be untagged. |}];; -(*******************************************************) -(* Test 11: float32 in extensible variants *) +(**************************************************) +(* Test 11: float32 banned in extensible variants *) type t11_1 = .. @@ -608,6 +585,16 @@ Line 5, characters 17-24: 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;; + +[%%expect{| +Line 1, characters 14-37: +1 | type t11_1 += C of t_float32 * string;; + ^^^^^^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, + t_float32, but found boxed argument, string. +|}] + (***************************************) (* Test 12: float32 in objects/classes *) @@ -827,3 +814,91 @@ Error: This expression has type t_float32 But the layout of t_float32 must be a sublayout of value, because of layout requirements from an imported definition. |}];; + +(***********************************************************) +(* Test 14: unboxed float32 records work like normal records *) + +module FU = struct + + external of_float32 : (float32[@local_opt]) -> float32# = "%unbox_float32" + + external to_float32 : float32# -> (float32[@local_opt]) = "%box_float32" + + external sub : + (float32[@local_opt]) -> (float32[@local_opt]) -> (float32[@local_opt]) + = "%subfloat32" + + external add : + (float32[@local_opt]) -> (float32[@local_opt]) -> (float32[@local_opt]) + = "%addfloat32" + + let[@inline always] sub x y = of_float32 (sub (to_float32 x) (to_float32 y)) + + let[@inline always] add x y = of_float32 (add (to_float32 x) (to_float32 y)) +end + +type t14_1 = { x : float32#; y : float32# } + +(* pattern matching *) +let f14_1 {x;y} = FU.sub x y + +(* construction *) +let r14 = { x = #3.14s; y = #2.72s } + +let sum14_1 = FU.to_float32 (f14_1 r14) + +(* projection *) +let f14_2 ({y;_} as r) = FU.sub r.x y + +let sum14_2 = FU.to_float32 (f14_1 r14) + +type t14_2 = { mutable a : float32#; b : float32#; mutable c : float32# } + +let f14_3 ({b; c; _} as r) = + (* pure record update *) + let r' = { r with b = #20.0s; c = r.a } in + (* mutation *) + r.a <- FU.sub r.a r'.b; + r'.a <- #42.0s; + r' + +let a, b, c, a', b', c' = + let r = {a = #3.1s; b = -#0.42s; c = #27.7s } in + let r' = f14_3 r in + FU.to_float32 r.a, + FU.to_float32 r.b, + FU.to_float32 r.c, + FU.to_float32 r'.a, + FU.to_float32 r'.b, + FU.to_float32 r'.c + +let f14_4 r = + let {x; y} = r in + FU.add x y + + +[%%expect{| +module FU : + sig + external of_float32 : (float32 [@local_opt]) -> float32# + = "%unbox_float32" + external to_float32 : float32# -> (float32 [@local_opt]) = "%box_float32" + val sub : float32# -> float32# -> float32# + val add : float32# -> float32# -> float32# + end +type t14_1 = { x : float32#; y : float32#; } +val f14_1 : t14_1 -> float32# = +val r14 : t14_1 = {x = ; y = } +val sum14_1 : float32 = 0.420000076s +val f14_2 : t14_1 -> float32# = +val sum14_2 : float32 = 0.420000076s +type t14_2 = { mutable a : float32#; b : float32#; mutable c : float32#; } +val f14_3 : t14_2 -> t14_2 = +val a : float32 = -16.8999996s +val b : float32 = -0.419999987s +val c : float32 = 27.7000008s +val a' : float32 = 42.s +val b' : float32 = 20.s +val c' : float32 = 3.0999999s +val f14_4 : t14_1 -> float32# = +|}] diff --git a/ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml deleted file mode 100644 index 40f58f9c835..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml +++ /dev/null @@ -1,908 +0,0 @@ -(* TEST - flambda2; - { - flags = "-extension layouts_alpha -extension small_numbers"; - expect; - }{ - flags = "-extension layouts_beta -extension small_numbers"; - expect; - } -*) - -(* This test is almost entirely a copy of [basics.ml], except - with different output for some layouts-beta features. - You should diff this file against [basics.ml] to see what's - different. -*) - -(* This file contains typing tests for the layout [float32]. - - Runtime tests for the type [float32#] can be found in the [unboxed_float] and - [alloc] tests in this directory. The type [float32#] here is used as a - convenient example of a concrete [float32] type in some tests, but its - behavior isn't the primary purpose of this test. *) - -type t_float32 : float32 -type ('a : float32) t_float32_id = 'a - -(*********************************) -(* Test 1: The identity function *) - -let f1_1 (x : t_float32) = x;; -let f1_2 (x : 'a t_float32_id) = x;; -let f1_3 (x : float32#) = x;; -[%%expect{| -type t_float32 : float32 -type ('a : float32) t_float32_id = 'a -val f1_1 : t_float32 -> t_float32 = -val f1_2 : ('a : float32). 'a t_float32_id -> 'a t_float32_id = -val f1_3 : float32# -> float32# = -|}];; - -(*****************************************) -(* Test 2: You can let-bind them locally *) -let f2_1 (x : t_float32) = - let y = x in - y;; - -let f2_2 (x : 'a t_float32_id) = - let y = x in - y;; - -let f2_3 (x : float32#) = - let y = x in - y;; -[%%expect{| -val f2_1 : t_float32 -> t_float32 = -val f2_2 : ('a : float32). 'a t_float32_id -> 'a t_float32_id = -val f2_3 : float32# -> float32# = -|}];; - -(*****************************************) -(* Test 3: No module-level bindings yet. *) - -let x3_1 : t_float32 = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_1 : t_float32 = assert false;; - ^^^^ -Error: Types of top-level module bindings must have layout value, but - the type of x3_1 has layout float32. -|}];; - -let x3_2 : 'a t_float32_id = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_2 : 'a t_float32_id = assert false;; - ^^^^ -Error: Types of top-level module bindings must have layout value, but - the type of x3_2 has layout float32. -|}];; - -let x3_3 : float32# = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_3 : float32# = assert false;; - ^^^^ -Error: Types of top-level module bindings must have layout value, but - the type of x3_3 has layout float32. -|}];; - -module M3_4 = struct - let x : t_float32 = assert false -end -[%%expect{| -Line 2, characters 6-7: -2 | let x : t_float32 = assert false - ^ -Error: Types of top-level module bindings must have layout value, but - the type of x has layout float32. -|}];; - -module M3_5 = struct - let f (x : float32#) = x - - let y = f (assert false) -end -[%%expect{| -Line 4, characters 6-7: -4 | let y = f (assert false) - ^ -Error: Types of top-level module bindings must have layout value, but - the type of y has layout float32. -|}];; - -(*************************************) -(* Test 4: No putting them in tuples *) - -let f4_1 (x : t_float32) = x, false;; -[%%expect{| -Line 1, characters 27-28: -1 | let f4_1 (x : t_float32) = x, false;; - ^ -Error: This expression has type t_float32 - but an expression was expected of type ('a : value) - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - it's the type of a tuple element. -|}];; - -let f4_2 (x : 'a t_float32_id) = x, false;; -[%%expect{| -Line 1, characters 33-34: -1 | let f4_2 (x : 'a t_float32_id) = x, false;; - ^ -Error: This expression has type 'a t_float32_id = ('a : float32) - but an expression was expected of type ('b : value) - The layout of 'a t_float32_id is float32, because - of the definition of t_float32_id at line 2, characters 0-37. - But the layout of 'a t_float32_id must overlap with value, because - it's the type of a tuple element. -|}];; - -let f4_3 (x : float32#) = x, false;; -[%%expect{| -Line 1, characters 26-27: -1 | let f4_3 (x : float32#) = x, false;; - ^ -Error: This expression has type float32# - but an expression was expected of type ('a : value) - The layout of float32# is float32, because - it is the primitive float32 type float32#. - But the layout of float32# must be a sublayout of value, because - it's the type of a tuple element. -|}];; - -type t4_4 = t_float32 * string;; -[%%expect{| -Line 1, characters 12-21: -1 | type t4_4 = t_float32 * string;; - ^^^^^^^^^ -Error: Tuple element types must have layout value. - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - it's the type of a tuple element. -|}];; - -type t4_5 = int * float32#;; -[%%expect{| -Line 1, characters 18-26: -1 | type t4_5 = int * float32#;; - ^^^^^^^^ -Error: Tuple element types must have layout value. - The layout of float32# is float32, because - it is the primitive float32 type float32#. - But the layout of float32# must be a sublayout of value, because - it's the type of a tuple element. -|}];; - -type ('a : float32) t4_6 = 'a * 'a -[%%expect{| -Line 1, characters 27-29: -1 | type ('a : float32) t4_6 = 'a * 'a - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float32) - The layout of 'a is float32, because - of the annotation on 'a in the declaration of the type t4_6. - But the layout of 'a must overlap with value, because - it's the type of a tuple element. -|}];; - -(* check for layout propagation *) -type ('a : float32, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; -[%%expect{| -Line 1, characters 32-34: -1 | type ('a : float32, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; - ^^ -Error: This type ('b : value) should be an instance of type ('a : float32) - The layout of 'a is float32, because - of the annotation on 'a in the declaration of the type t4_7. - But the layout of 'a must overlap with value, because - it's the type of a tuple element. -|}] - -(*****************************************) -(* Test 5: float32 in structures *) - -(* all-float32 records are allowed, as are some records that mix float32 and - value fields. See [tests/typing-layouts/mixed_records.ml] for tests of mixed - records. *) -type t5_1 = { x : t_float32 };; -[%%expect{| -type t5_1 = { x : t_float32; } -|}];; - -(* CR layouts 2.5: allow this *) -type t5_3 = { x : t_float32 } [@@unboxed];; -[%%expect{| -Line 1, characters 14-27: -1 | type t5_3 = { x : t_float32 } [@@unboxed];; - ^^^^^^^^^^^^^ -Error: Type t_float32 has layout float32. - Unboxed records may not yet contain types of this layout. -|}];; - -type t5_4 = A of t_float32;; -[%%expect{| -type t5_4 = A of t_float32 -|}];; - -type t5_5 = A of int * t_float32;; -[%%expect{| -type t5_5 = A of int * t_float32 -|}];; - -type t5_6 = A of t_float32 [@@unboxed];; -[%%expect{| -Line 1, characters 12-26: -1 | type t5_6 = A of t_float32 [@@unboxed];; - ^^^^^^^^^^^^^^ -Error: Type t_float32 has layout float32. - Unboxed variants may not yet contain types of this layout. -|}];; - -type ('a : float32) t5_7 = A of int -type ('a : float32) t5_8 = A of 'a;; -[%%expect{| -type ('a : float32) t5_7 = A of int -type ('a : float32) t5_8 = A of 'a -|}] - -type ('a : float32, 'b : float32) t5_9 = {x : 'a; y : 'b; z : 'a} - -type 'a t5_10 = 'a t_float32_id -and 'a t5_11 = {x : 'a t5_10; y : 'a} -[%%expect{| -type ('a : float32, 'b : float32) t5_9 = { x : 'a; y : 'b; z : 'a; } -Line 4, characters 20-28: -4 | and 'a t5_11 = {x : 'a t5_10; y : 'a} - ^^^^^^^^ -Error: Layout mismatch in final type declaration consistency check. - This is most often caused by the fact that type inference is not - clever enough to propagate layouts through variables in different - declarations. It is also not clever enough to produce a good error - message, so we'll say this instead: - The layout of 'a is float32, because - of the definition of t_float32_id at line 2, characters 0-37. - But the layout of 'a must overlap with value, because - it instantiates an unannotated type parameter of t5_11, defaulted to layout value. - A good next step is to add a layout annotation on a parameter to - the declaration where this error is reported. -|}];; - -type ('a : float32) t5_12 = {x : 'a; y : float32#};; -[%%expect{| -type ('a : float32) t5_12 = { x : 'a; y : float32#; } -|}];; - -type ('a : float32) t5_13 = {x : 'a; y : float32#};; -[%%expect{| -type ('a : float32) t5_13 = { x : 'a; y : float32#; } -|}];; - -type ufref = { mutable contents : float32# };; -[%%expect{| -type ufref = { mutable contents : float32#; } -|}];; - -(****************************************************) -(* Test 6: Can't be put at top level of signatures. *) -module type S6_1 = sig val x : t_float32 end - -let f6 (m : (module S6_1)) = let module M6 = (val m) in M6.x;; -[%%expect{| -Line 1, characters 31-40: -1 | module type S6_1 = sig val x : t_float32 end - ^^^^^^^^^ -Error: This type signature for x is not a value type. - The layout of type t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of type t_float32 must be a sublayout of value, because - it's the type of something stored in a module structure. -|}];; - -module type S6_2 = sig val x : 'a t_float32_id end -[%%expect{| -Line 1, characters 31-46: -1 | module type S6_2 = sig val x : 'a t_float32_id end - ^^^^^^^^^^^^^^^ -Error: This type signature for x is not a value type. - The layout of type 'a t_float32_id is float32, because - of the definition of t_float32_id at line 2, characters 0-37. - But the layout of type 'a t_float32_id must be a sublayout of value, because - it's the type of something stored in a module structure. -|}];; - -module type S6_3 = sig val x : float32# end -[%%expect{| -Line 1, characters 31-39: -1 | module type S6_3 = sig val x : float32# end - ^^^^^^^^ -Error: This type signature for x is not a value type. - The layout of type float32# is float32, because - it is the primitive float32 type float32#. - But the layout of type float32# must be a sublayout of value, because - it's the type of something stored in a module structure. -|}];; - - -(*********************************************************) -(* Test 7: Can't be used as polymorphic variant argument *) -let f7_1 (x : t_float32) = `A x;; -[%%expect{| -Line 1, characters 30-31: -1 | let f7_1 (x : t_float32) = `A x;; - ^ -Error: This expression has type t_float32 - but an expression was expected of type ('a : value) - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - it's the type of the field of a polymorphic variant. -|}];; - -let f7_2 (x : 'a t_float32_id) = `A x;; -[%%expect{| -Line 1, characters 36-37: -1 | let f7_2 (x : 'a t_float32_id) = `A x;; - ^ -Error: This expression has type 'a t_float32_id = ('a : float32) - but an expression was expected of type ('b : value) - The layout of 'a t_float32_id is float32, because - of the definition of t_float32_id at line 2, characters 0-37. - But the layout of 'a t_float32_id must overlap with value, because - it's the type of the field of a polymorphic variant. -|}];; - -let f7_3 (x : float32#) = `A x;; -[%%expect{| -Line 1, characters 29-30: -1 | let f7_3 (x : float32#) = `A x;; - ^ -Error: This expression has type float32# - but an expression was expected of type ('a : value) - The layout of float32# is float32, because - it is the primitive float32 type float32#. - But the layout of float32# must be a sublayout of value, because - it's the type of the field of a polymorphic variant. -|}];; - -type f7_4 = [ `A of t_float32 ];; -[%%expect{| -Line 1, characters 20-29: -1 | type f7_4 = [ `A of t_float32 ];; - ^^^^^^^^^ -Error: Polymorphic variant constructor argument types must have layout value. - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - it's the type of the field of a polymorphic variant. -|}];; - -type ('a : float32) f7_5 = [ `A of 'a ];; -[%%expect{| -Line 1, characters 35-37: -1 | type ('a : float32) f7_5 = [ `A of 'a ];; - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float32) - The layout of 'a is float32, because - of the annotation on 'a in the declaration of the type f7_5. - But the layout of 'a must overlap with value, because - it's the type of the field of a polymorphic variant. -|}];; - -(************************************************************) -(* Test 8: Normal polymorphic functions don't work on them. *) - -let make_t_float32 () : t_float32 = assert false -let make_t_float32_id () : 'a t_float32_id = assert false -let make_floatu () : float32# = assert false - -let id_value x = x;; -[%%expect{| -val make_t_float32 : unit -> t_float32 = -val make_t_float32_id : ('a : float32). unit -> 'a t_float32_id = -val make_floatu : unit -> float32# = -val id_value : 'a -> 'a = -|}];; - -let x8_1 = id_value (make_t_float32 ());; -[%%expect{| -Line 1, characters 20-39: -1 | let x8_1 = id_value (make_t_float32 ());; - ^^^^^^^^^^^^^^^^^^^ -Error: This expression has type t_float32 - but an expression was expected of type ('a : value) - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - of the definition of id_value at line 5, characters 13-18. -|}];; - -let x8_2 = id_value (make_t_float32_id ());; -[%%expect{| -Line 1, characters 20-42: -1 | let x8_2 = id_value (make_t_float32_id ());; - ^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type 'a t_float32_id = ('a : float32) - but an expression was expected of type ('b : value) - The layout of 'a t_float32_id is float32, because - of the definition of make_t_float32_id at line 2, characters 22-57. - But the layout of 'a t_float32_id must overlap with value, because - of the definition of id_value at line 5, characters 13-18. -|}];; - -let x8_3 = id_value (make_floatu ());; -[%%expect{| -Line 1, characters 20-36: -1 | let x8_3 = id_value (make_floatu ());; - ^^^^^^^^^^^^^^^^ -Error: This expression has type float32# - but an expression was expected of type ('a : value) - The layout of float32# is float32, because - it is the primitive float32 type float32#. - But the layout of float32# must be a sublayout of value, because - of the definition of id_value at line 5, characters 13-18. -|}];; - -(*************************************) -(* Test 9: But float32 functions do. *) - -let twice f (x : 'a t_float32_id) = f (f x) - -let f9_1 () = twice f1_1 (make_t_float32 ()) -let f9_2 () = twice f1_2 (make_t_float32_id ()) -let f9_3 () = twice f1_3 (make_floatu ());; -[%%expect{| -val twice : - ('a : float32). - ('a t_float32_id -> 'a t_float32_id) -> - 'a t_float32_id -> 'a t_float32_id = - -val f9_1 : unit -> t_float32 t_float32_id = -val f9_2 : ('a : float32). unit -> 'a t_float32_id = -val f9_3 : unit -> float32# t_float32_id = -|}];; - -(**************************************************) -(* Test 10: Invalid uses of float32 and externals *) - -(* Valid uses of float32 in externals are tested elsewhere - this is just a test - for uses the typechecker should reject. In particular - - if using a non-value layout in an external, you must supply separate - bytecode and native code implementations, - - if using a non-value layout in an external, you may not use the old-style - unboxed float directive, and - - [@unboxed] is allowed on unboxed types but has no effect. Same is not - true for [@untagged]. -*) - -external f10_1 : int -> bool -> float32# = "foo";; -[%%expect{| -Line 1, characters 0-48: -1 | external f10_1 : int -> bool -> float32# = "foo";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The native code version of the primitive is mandatory - for types with non-value layouts. -|}];; - -external f10_2 : t_float32 -> int = "foo";; -[%%expect{| -Line 1, characters 0-41: -1 | external f10_2 : t_float32 -> int = "foo";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The native code version of the primitive is mandatory - for types with non-value layouts. -|}];; - -external f10_3 : float32 -> t_float32 = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-60: -1 | external f10_3 : float32 -> t_float32 = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_4 : int -> float32# -> float32 = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-66: -1 | external f10_4 : int -> float32# -> float32 = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_5 : float32# -> bool -> string = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-66: -1 | external f10_5 : float32# -> bool -> string = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_6 : (float32#[@unboxed]) -> bool -> string = "foo" "bar";; -[%%expect{| -external f10_6 : float32# -> bool -> string = "foo" "bar" -|}];; - -external f10_7 : string -> (float32#[@unboxed]) = "foo" "bar";; -[%%expect{| -external f10_7 : string -> float32# = "foo" "bar" -|}];; - -external f10_8 : float -> float32# = "foo" "bar" [@@unboxed];; -[%%expect{| -external f10_8 : (float [@unboxed]) -> float32# = "foo" "bar" -|}];; - -external f10_9 : (float32#[@untagged]) -> bool -> string = "foo" "bar";; -[%%expect{| -Line 1, characters 18-26: -1 | external f10_9 : (float32#[@untagged]) -> bool -> string = "foo" "bar";; - ^^^^^^^^ -Error: Don't know how to untag this type. Only int can be untagged. -|}];; - -external f10_10 : string -> (float32#[@untagged]) = "foo" "bar";; -[%%expect{| -Line 1, characters 29-37: -1 | external f10_10 : string -> (float32#[@untagged]) = "foo" "bar";; - ^^^^^^^^ -Error: Don't know how to untag this type. Only int can be untagged. -|}];; - -(*******************************************************) -(* Test 11: float32 in extensible variants *) - -type t11_1 = .. - -type t11_1 += A of t_float32;; -[%%expect{| -type t11_1 = .. -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{| -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 = .. - -type 'a t11_2 += A of int - -type 'a t11_2 += B of 'a;; - -[%%expect{| -type ('a : float32) t11_2 = .. -type 'a t11_2 += A of int -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;; - -[%%expect{| -Line 1, characters 14-37: -1 | type t11_1 += C of t_float32 * string;; - ^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - t_float32, but found boxed argument, string. -|}] - -(***************************************) -(* Test 12: float32 in objects/classes *) - -(* First, disallowed uses: in object types, class parameters, etc. *) -type t12_1 = < x : t_float32 >;; -[%%expect{| -Line 1, characters 15-28: -1 | type t12_1 = < x : t_float32 >;; - ^^^^^^^^^^^^^ -Error: Object field types must have layout value. - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - it's the type of an object field. -|}];; - -type ('a : float32) t12_2 = < x : 'a >;; -[%%expect{| -Line 1, characters 34-36: -1 | type ('a : float32) t12_2 = < x : 'a >;; - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float32) - The layout of 'a is float32, because - of the annotation on 'a in the declaration of the type t12_2. - But the layout of 'a must overlap with value, because - it's the type of an object field. -|}] - -class c12_3 = object method x : t_float32 = assert false end;; -[%%expect{| -Line 1, characters 21-56: -1 | class c12_3 = object method x : t_float32 = assert false end;; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The method x has type t_float32 but is expected to have type - ('a : value) - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - it's the type of an object field. -|}];; - -class ['a] c12_4 = object - method x : 'a t_float32_id -> 'a t_float32_id = assert false -end;; -[%%expect{| -Line 2, characters 13-15: -2 | method x : 'a t_float32_id -> 'a t_float32_id = assert false - ^^ -Error: This type ('a : float32) should be an instance of type ('a0 : value) - The layout of 'a is value, because - it's a type argument to a class constructor. - But the layout of 'a must overlap with float32, because - of the definition of t_float32_id at line 2, characters 0-37. -|}];; - -class c12_5 = object val x : t_float32 = assert false end;; -[%%expect{| -Line 1, characters 25-26: -1 | class c12_5 = object val x : t_float32 = assert false end;; - ^ -Error: Variables bound in a class must have layout value. - The layout of x is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of x must be a sublayout of value, because - it's the type of a class field. -|}];; - -class type c12_6 = object method x : float32# end;; -[%%expect{| -Line 1, characters 26-45: -1 | class type c12_6 = object method x : float32# end;; - ^^^^^^^^^^^^^^^^^^^ -Error: The method x has type float32# but is expected to have type - ('a : value) - The layout of float32# is float32, because - it is the primitive float32 type float32#. - But the layout of float32# must be a sublayout of value, because - it's the type of an object field. -|}];; - -class type c12_7 = object val x : float32# end -[%%expect{| -Line 1, characters 26-42: -1 | class type c12_7 = object val x : float32# end - ^^^^^^^^^^^^^^^^ -Error: Variables bound in a class must have layout value. - The layout of x is float32, because - it is the primitive float32 type float32#. - But the layout of x must be a sublayout of value, because - it's the type of an instance variable. -|}];; - -class type ['a] c12_8 = object - val x : 'a t_float32_id -> 'a t_float32_id -end -[%%expect{| -Line 2, characters 10-12: -2 | val x : 'a t_float32_id -> 'a t_float32_id - ^^ -Error: This type ('a : float32) should be an instance of type ('a0 : value) - The layout of 'a is value, because - it's a type argument to a class constructor. - But the layout of 'a must overlap with float32, because - of the definition of t_float32_id at line 2, characters 0-37. -|}];; - -(* Second, allowed uses: as method parameters / returns *) -type t12_8 = < f : t_float32 -> t_float32 > -let f12_9 (o : t12_8) x = o#f x -let f12_10 o (y : t_float32) : t_float32 = o#baz y y y;; -class ['a] c12_11 = object - method x : t_float32 -> 'a = assert false -end;; -class ['a] c12_12 = object - method x : 'a -> t_float32 = assert false -end;; -[%%expect{| -type t12_8 = < f : t_float32 -> t_float32 > -val f12_9 : t12_8 -> t_float32 -> t_float32 = -val f12_10 : - < baz : t_float32 -> t_float32 -> t_float32 -> t_float32; .. > -> - t_float32 -> t_float32 = -class ['a] c12_11 : object method x : t_float32 -> 'a end -class ['a] c12_12 : object method x : 'a -> t_float32 end -|}];; - -(* Third, another disallowed use: capture in an object. *) -let f12_13 m1 m2 = object - val f = fun () -> - let _ = f1_1 m1 in - let _ = f1_1 m2 in - () -end;; -[%%expect{| -Line 3, characters 17-19: -3 | let _ = f1_1 m1 in - ^^ -Error: This expression has type ('a : value) - but an expression was expected of type t_float32 - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - it's the type of a variable captured in an object. -|}];; - -let f12_14 (m1 : t_float32) (m2 : t_float32) = object - val f = fun () -> - let _ = f1_1 m1 in - let _ = f1_1 m2 in - () -end;; -[%%expect{| -Line 3, characters 17-19: -3 | let _ = f1_1 m1 in - ^^ -Error: m1 must have a type of layout value because it is captured by an object. - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - it's the type of a variable captured in an object. -|}];; - -(*********************************************************************) -(* Test 13: Ad-hoc polymorphic operations don't work on float32 yet. *) - -(* CR layouts v5: Remember to handle the case of calling these on structures - containing other layouts. *) - -let f13_1 (x : t_float32) = x = x;; -[%%expect{| -Line 1, characters 28-29: -1 | let f13_1 (x : t_float32) = x = x;; - ^ -Error: This expression has type t_float32 - but an expression was expected of type ('a : value) - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - of layout requirements from an imported definition. -|}];; - -let f13_2 (x : t_float32) = compare x x;; -[%%expect{| -Line 1, characters 36-37: -1 | let f13_2 (x : t_float32) = compare x x;; - ^ -Error: This expression has type t_float32 - but an expression was expected of type ('a : value) - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - of layout requirements from an imported definition. -|}];; - -let f13_3 (x : t_float32) = Marshal.to_bytes x;; -[%%expect{| -Line 1, characters 45-46: -1 | let f13_3 (x : t_float32) = Marshal.to_bytes x;; - ^ -Error: This expression has type t_float32 - but an expression was expected of type ('a : value) - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - of layout requirements from an imported definition. -|}];; - -let f13_4 (x : t_float32) = Hashtbl.hash x;; -[%%expect{| -Line 1, characters 41-42: -1 | let f13_4 (x : t_float32) = Hashtbl.hash x;; - ^ -Error: This expression has type t_float32 - but an expression was expected of type ('a : value) - The layout of t_float32 is float32, because - of the definition of t_float32 at line 1, characters 0-24. - But the layout of t_float32 must be a sublayout of value, because - of layout requirements from an imported definition. -|}];; - -(***********************************************************) -(* Test 14: unboxed float32 records work like normal records *) - -module FU = struct - - external of_float32 : (float32[@local_opt]) -> float32# = "%unbox_float32" - - external to_float32 : float32# -> (float32[@local_opt]) = "%box_float32" - - external sub : - (float32[@local_opt]) -> (float32[@local_opt]) -> (float32[@local_opt]) - = "%subfloat32" - - external add : - (float32[@local_opt]) -> (float32[@local_opt]) -> (float32[@local_opt]) - = "%addfloat32" - - let[@inline always] sub x y = of_float32 (sub (to_float32 x) (to_float32 y)) - - let[@inline always] add x y = of_float32 (add (to_float32 x) (to_float32 y)) -end - -type t14_1 = { x : float32#; y : float32# } - -(* pattern matching *) -let f14_1 {x;y} = FU.sub x y - -(* construction *) -let r14 = { x = #3.14s; y = #2.72s } - -let sum14_1 = FU.to_float32 (f14_1 r14) - -(* projection *) -let f14_2 ({y;_} as r) = FU.sub r.x y - -let sum14_2 = FU.to_float32 (f14_1 r14) - -type t14_2 = { mutable a : float32#; b : float32#; mutable c : float32# } - -let f14_3 ({b; c; _} as r) = - (* pure record update *) - let r' = { r with b = #20.0s; c = r.a } in - (* mutation *) - r.a <- FU.sub r.a r'.b; - r'.a <- #42.0s; - r' - -let a, b, c, a', b', c' = - let r = {a = #3.1s; b = -#0.42s; c = #27.7s } in - let r' = f14_3 r in - FU.to_float32 r.a, - FU.to_float32 r.b, - FU.to_float32 r.c, - FU.to_float32 r'.a, - FU.to_float32 r'.b, - FU.to_float32 r'.c - -let f14_4 r = - let {x; y} = r in - FU.add x y - - -[%%expect{| -module FU : - sig - external of_float32 : (float32 [@local_opt]) -> float32# - = "%unbox_float32" - external to_float32 : float32# -> (float32 [@local_opt]) = "%box_float32" - val sub : float32# -> float32# -> float32# - val add : float32# -> float32# -> float32# - end -type t14_1 = { x : float32#; y : float32#; } -val f14_1 : t14_1 -> float32# = -val r14 : t14_1 = {x = ; y = } -val sum14_1 : float32 = 0.420000076s -val f14_2 : t14_1 -> float32# = -val sum14_2 : float32 = 0.420000076s -type t14_2 = { mutable a : float32#; b : float32#; mutable c : float32#; } -val f14_3 : t14_2 -> t14_2 = -val a : float32 = -16.8999996s -val b : float32 = -0.419999987s -val c : float32 = 27.7000008s -val a' : float32 = 42.s -val b' : float32 = 20.s -val c' : float32 = 3.0999999s -val f14_4 : t14_1 -> float32# = -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-float64/basics.ml b/ocaml/testsuite/tests/typing-layouts-float64/basics.ml index 44a13cedc7d..68ad9896569 100644 --- a/ocaml/testsuite/tests/typing-layouts-float64/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-float64/basics.ml @@ -222,20 +222,12 @@ Error: Type t_float64 has layout float64. constructor args. *) type t5_4 = A of t_float64;; [%%expect{| -Line 1, characters 12-26: -1 | type t5_4 = 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. +type t5_4 = A of t_float64 |}];; type t5_5 = A of int * t_float64;; [%%expect{| -Line 1, characters 12-32: -1 | type t5_5 = A of int * t_float64;; - ^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t5_5 = A of int * t_float64 |}];; type t5_6 = A of t_float64 [@@unboxed];; @@ -251,11 +243,7 @@ type ('a : float64) t5_7 = A of int type ('a : float64) t5_8 = A of 'a;; [%%expect{| type ('a : float64) t5_7 = A of int -Line 2, characters 27-34: -2 | type ('a : float64) t5_8 = A of 'a;; - ^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type ('a : float64) t5_8 = A of 'a |}] type ('a : float64, 'b : float64) t5_9 = {x : 'a; y : 'b; z : 'a} @@ -290,14 +278,9 @@ type ('a : float64) t5_13 = {x : 'a; y : float#};; type ('a : float64) t5_13 = { x : 'a; y : float#; } |}];; -(* Mixed records are allowed, but are prohibited outside of alpha. *) type 'a t5_14 = {x : 'a; y : float#};; [%%expect{| -Line 1, characters 0-36: -1 | type 'a t5_14 = {x : 'a; y : float#};; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type 'a t5_14 = { x : 'a; y : float#; } |}];; type ufref = { mutable contents : float# };; @@ -570,12 +553,10 @@ Line 1, characters 29-35: 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. *) +(**************************************************) +(* Test 11: float64 banned in extensible variants *) -(* Currently these are only supported in alpha *) +(* CR layouts v5.9: Allow mixed extensible variant blocks. *) type t11_1 = .. diff --git a/ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml deleted file mode 100644 index b5d3fba1166..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml +++ /dev/null @@ -1,894 +0,0 @@ -(* TEST - include stdlib_upstream_compatible; - flambda2; - { - flags = "-extension layouts_alpha"; - expect; - }{ - flags = "-extension layouts_beta"; - expect; - } -*) - -(* This test is almost entirely a copy of [basics.ml], except - with different output for some layouts-beta features. - You should diff this file against [basics.ml] to see what's - different. -*) - -(* This file contains typing tests for the layout [float64]. - - Runtime tests for the type [float#] can be found in the [unboxed_float] and - [alloc] tests in this directory. The type [float#] here is used as a - convenient example of a concrete [float64] type in some tests, but its - behavior isn't the primary purpose of this test. *) - -type t_float64 : float64 -type ('a : float64) t_float64_id = 'a - -(*********************************) -(* Test 1: The identity function *) - -let f1_1 (x : t_float64) = x;; -let f1_2 (x : 'a t_float64_id) = x;; -let f1_3 (x : float#) = x;; -[%%expect{| -type t_float64 : float64 -type ('a : float64) t_float64_id = 'a -val f1_1 : t_float64 -> t_float64 = -val f1_2 : ('a : float64). 'a t_float64_id -> 'a t_float64_id = -val f1_3 : float# -> float# = -|}];; - -(*****************************************) -(* Test 2: You can let-bind them locally *) -let f2_1 (x : t_float64) = - let y = x in - y;; - -let f2_2 (x : 'a t_float64_id) = - let y = x in - y;; - -let f2_3 (x : float#) = - let y = x in - y;; -[%%expect{| -val f2_1 : t_float64 -> t_float64 = -val f2_2 : ('a : float64). 'a t_float64_id -> 'a t_float64_id = -val f2_3 : float# -> float# = -|}];; - -(*****************************************) -(* Test 3: No module-level bindings yet. *) - -let x3_1 : t_float64 = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_1 : t_float64 = assert false;; - ^^^^ -Error: Types of top-level module bindings must have layout value, but - the type of x3_1 has layout float64. -|}];; - -let x3_2 : 'a t_float64_id = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_2 : 'a t_float64_id = assert false;; - ^^^^ -Error: Types of top-level module bindings must have layout value, but - the type of x3_2 has layout float64. -|}];; - -let x3_3 : float# = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_3 : float# = assert false;; - ^^^^ -Error: Types of top-level module bindings must have layout value, but - the type of x3_3 has layout float64. -|}];; - -module M3_4 = struct - let x : t_float64 = assert false -end -[%%expect{| -Line 2, characters 6-7: -2 | let x : t_float64 = assert false - ^ -Error: Types of top-level module bindings must have layout value, but - the type of x has layout float64. -|}];; - -module M3_5 = struct - let f (x : float#) = x - - let y = f (assert false) -end -[%%expect{| -Line 4, characters 6-7: -4 | let y = f (assert false) - ^ -Error: Types of top-level module bindings must have layout value, but - the type of y has layout float64. -|}];; - -(*************************************) -(* Test 4: No putting them in tuples *) - -let f4_1 (x : t_float64) = x, false;; -[%%expect{| -Line 1, characters 27-28: -1 | let f4_1 (x : t_float64) = x, false;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - it's the type of a tuple element. -|}];; - -let f4_2 (x : 'a t_float64_id) = x, false;; -[%%expect{| -Line 1, characters 33-34: -1 | let f4_2 (x : 'a t_float64_id) = x, false;; - ^ -Error: This expression has type 'a t_float64_id = ('a : float64) - but an expression was expected of type ('b : value) - The layout of 'a t_float64_id is float64, because - of the definition of t_float64_id at line 2, characters 0-37. - But the layout of 'a t_float64_id must overlap with value, because - it's the type of a tuple element. -|}];; - -let f4_3 (x : float#) = x, false;; -[%%expect{| -Line 1, characters 24-25: -1 | let f4_3 (x : float#) = x, false;; - ^ -Error: This expression has type float# but an expression was expected of type - ('a : value) - The layout of float# is float64, because - it is the primitive float64 type float#. - But the layout of float# must be a sublayout of value, because - it's the type of a tuple element. -|}];; - -type t4_4 = t_float64 * string;; -[%%expect{| -Line 1, characters 12-21: -1 | type t4_4 = t_float64 * string;; - ^^^^^^^^^ -Error: Tuple element types must have layout value. - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - it's the type of a tuple element. -|}];; - -type t4_5 = int * float#;; -[%%expect{| -Line 1, characters 18-24: -1 | type t4_5 = int * float#;; - ^^^^^^ -Error: Tuple element types must have layout value. - The layout of float# is float64, because - it is the primitive float64 type float#. - But the layout of float# must be a sublayout of value, because - it's the type of a tuple element. -|}];; - -type ('a : float64) t4_6 = 'a * 'a -[%%expect{| -Line 1, characters 27-29: -1 | type ('a : float64) t4_6 = 'a * 'a - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float64) - The layout of 'a is float64, because - of the annotation on 'a in the declaration of the type t4_6. - But the layout of 'a must overlap with value, because - it's the type of a tuple element. -|}];; - -(* check for layout propagation *) -type ('a : float64, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; -[%%expect{| -Line 1, characters 32-34: -1 | type ('a : float64, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; - ^^ -Error: This type ('b : value) should be an instance of type ('a : float64) - The layout of 'a is float64, because - of the annotation on 'a in the declaration of the type t4_7. - But the layout of 'a must overlap with value, because - it's the type of a tuple element. -|}] - -(*****************************************) -(* Test 5: Can be put in some structures *) - -(* all-float64 records are allowed, as are some records that mix float64 and - value fields. See [tests/typing-layouts/mixed_records.ml] for tests of mixed - records. *) -type t5_1 = { x : t_float64 };; -[%%expect{| -type t5_1 = { x : t_float64; } -|}];; - -(* CR layouts 2.5: allow this *) -type t5_3 = { x : t_float64 } [@@unboxed];; -[%%expect{| -Line 1, characters 14-27: -1 | type t5_3 = { x : t_float64 } [@@unboxed];; - ^^^^^^^^^^^^^ -Error: Type t_float64 has layout float64. - Unboxed records may not yet contain types of this layout. -|}];; - -(* all-float64 constructor args are also allowed, as are some constructors that - mix float64 and value fields. These are only allowed in alpha, though. See - [tests/typing-layouts/mixed_constructor_args.ml] for tests of mixed - constructor args. *) -type t5_4 = A of t_float64;; -[%%expect{| -type t5_4 = A of t_float64 -|}];; - -type t5_5 = A of int * t_float64;; -[%%expect{| -type t5_5 = A of int * t_float64 -|}];; - -type t5_6 = A of t_float64 [@@unboxed];; -[%%expect{| -Line 1, characters 12-26: -1 | type t5_6 = A of t_float64 [@@unboxed];; - ^^^^^^^^^^^^^^ -Error: Type t_float64 has layout float64. - Unboxed variants may not yet contain types of this layout. -|}];; - -type ('a : float64) t5_7 = A of int -type ('a : float64) t5_8 = A of 'a;; -[%%expect{| -type ('a : float64) t5_7 = A of int -type ('a : float64) t5_8 = A of 'a -|}] - -type ('a : float64, 'b : float64) t5_9 = {x : 'a; y : 'b; z : 'a} - -type 'a t5_10 = 'a t_float64_id -and 'a t5_11 = {x : 'a t5_10; y : 'a} -[%%expect{| -type ('a : float64, 'b : float64) t5_9 = { x : 'a; y : 'b; z : 'a; } -Line 4, characters 20-28: -4 | and 'a t5_11 = {x : 'a t5_10; y : 'a} - ^^^^^^^^ -Error: Layout mismatch in final type declaration consistency check. - This is most often caused by the fact that type inference is not - clever enough to propagate layouts through variables in different - declarations. It is also not clever enough to produce a good error - message, so we'll say this instead: - The layout of 'a is float64, because - of the definition of t_float64_id at line 2, characters 0-37. - But the layout of 'a must overlap with value, because - it instantiates an unannotated type parameter of t5_11, defaulted to layout value. - A good next step is to add a layout annotation on a parameter to - the declaration where this error is reported. -|}];; - -type ('a : float64) t5_12 = {x : 'a; y : float#};; -[%%expect{| -type ('a : float64) t5_12 = { x : 'a; y : float#; } -|}];; - -type ('a : float64) t5_13 = {x : 'a; y : float#};; -[%%expect{| -type ('a : float64) t5_13 = { x : 'a; y : float#; } -|}];; - -type ufref = { mutable contents : float# };; -[%%expect{| -type ufref = { mutable contents : float#; } -|}];; - -(****************************************************) -(* Test 6: Can't be put at top level of signatures. *) -module type S6_1 = sig val x : t_float64 end - -let f6 (m : (module S6_1)) = let module M6 = (val m) in M6.x;; -[%%expect{| -Line 1, characters 31-40: -1 | module type S6_1 = sig val x : t_float64 end - ^^^^^^^^^ -Error: This type signature for x is not a value type. - The layout of type t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of type t_float64 must be a sublayout of value, because - it's the type of something stored in a module structure. -|}];; - -module type S6_2 = sig val x : 'a t_float64_id end -[%%expect{| -Line 1, characters 31-46: -1 | module type S6_2 = sig val x : 'a t_float64_id end - ^^^^^^^^^^^^^^^ -Error: This type signature for x is not a value type. - The layout of type 'a t_float64_id is float64, because - of the definition of t_float64_id at line 2, characters 0-37. - But the layout of type 'a t_float64_id must be a sublayout of value, because - it's the type of something stored in a module structure. -|}];; - -module type S6_3 = sig val x : float# end -[%%expect{| -Line 1, characters 31-37: -1 | module type S6_3 = sig val x : float# end - ^^^^^^ -Error: This type signature for x is not a value type. - The layout of type float# is float64, because - it is the primitive float64 type float#. - But the layout of type float# must be a sublayout of value, because - it's the type of something stored in a module structure. -|}];; - - -(*********************************************************) -(* Test 7: Can't be used as polymorphic variant argument *) -let f7_1 (x : t_float64) = `A x;; -[%%expect{| -Line 1, characters 30-31: -1 | let f7_1 (x : t_float64) = `A x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - it's the type of the field of a polymorphic variant. -|}];; - -let f7_2 (x : 'a t_float64_id) = `A x;; -[%%expect{| -Line 1, characters 36-37: -1 | let f7_2 (x : 'a t_float64_id) = `A x;; - ^ -Error: This expression has type 'a t_float64_id = ('a : float64) - but an expression was expected of type ('b : value) - The layout of 'a t_float64_id is float64, because - of the definition of t_float64_id at line 2, characters 0-37. - But the layout of 'a t_float64_id must overlap with value, because - it's the type of the field of a polymorphic variant. -|}];; - -let f7_3 (x : float#) = `A x;; -[%%expect{| -Line 1, characters 27-28: -1 | let f7_3 (x : float#) = `A x;; - ^ -Error: This expression has type float# but an expression was expected of type - ('a : value) - The layout of float# is float64, because - it is the primitive float64 type float#. - But the layout of float# must be a sublayout of value, because - it's the type of the field of a polymorphic variant. -|}];; - -type f7_4 = [ `A of t_float64 ];; -[%%expect{| -Line 1, characters 20-29: -1 | type f7_4 = [ `A of t_float64 ];; - ^^^^^^^^^ -Error: Polymorphic variant constructor argument types must have layout value. - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - it's the type of the field of a polymorphic variant. -|}];; - -type ('a : float64) f7_5 = [ `A of 'a ];; -[%%expect{| -Line 1, characters 35-37: -1 | type ('a : float64) f7_5 = [ `A of 'a ];; - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float64) - The layout of 'a is float64, because - of the annotation on 'a in the declaration of the type f7_5. - But the layout of 'a must overlap with value, because - it's the type of the field of a polymorphic variant. -|}];; - -(************************************************************) -(* Test 8: Normal polymorphic functions don't work on them. *) - -let make_t_float64 () : t_float64 = assert false -let make_t_float64_id () : 'a t_float64_id = assert false -let make_floatu () : float# = assert false - -let id_value x = x;; -[%%expect{| -val make_t_float64 : unit -> t_float64 = -val make_t_float64_id : ('a : float64). unit -> 'a t_float64_id = -val make_floatu : unit -> float# = -val id_value : 'a -> 'a = -|}];; - -let x8_1 = id_value (make_t_float64 ());; -[%%expect{| -Line 1, characters 20-39: -1 | let x8_1 = id_value (make_t_float64 ());; - ^^^^^^^^^^^^^^^^^^^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - of the definition of id_value at line 5, characters 13-18. -|}];; - -let x8_2 = id_value (make_t_float64_id ());; -[%%expect{| -Line 1, characters 20-42: -1 | let x8_2 = id_value (make_t_float64_id ());; - ^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type 'a t_float64_id = ('a : float64) - but an expression was expected of type ('b : value) - The layout of 'a t_float64_id is float64, because - of the definition of make_t_float64_id at line 2, characters 22-57. - But the layout of 'a t_float64_id must overlap with value, because - of the definition of id_value at line 5, characters 13-18. -|}];; - -let x8_3 = id_value (make_floatu ());; -[%%expect{| -Line 1, characters 20-36: -1 | let x8_3 = id_value (make_floatu ());; - ^^^^^^^^^^^^^^^^ -Error: This expression has type float# but an expression was expected of type - ('a : value) - The layout of float# is float64, because - it is the primitive float64 type float#. - But the layout of float# must be a sublayout of value, because - of the definition of id_value at line 5, characters 13-18. -|}];; - -(*************************************) -(* Test 9: But float64 functions do. *) - -let twice f (x : 'a t_float64_id) = f (f x) - -let f9_1 () = twice f1_1 (make_t_float64 ()) -let f9_2 () = twice f1_2 (make_t_float64_id ()) -let f9_3 () = twice f1_3 (make_floatu ());; -[%%expect{| -val twice : - ('a : float64). - ('a t_float64_id -> 'a t_float64_id) -> - 'a t_float64_id -> 'a t_float64_id = - -val f9_1 : unit -> t_float64 t_float64_id = -val f9_2 : ('a : float64). unit -> 'a t_float64_id = -val f9_3 : unit -> float# t_float64_id = -|}];; - -(**************************************************) -(* Test 10: Invalid uses of float64 and externals *) - -(* Valid uses of float64 in externals are tested elsewhere - this is just a test - for uses the typechecker should reject. In particular - - if using a non-value layout in an external, you must supply separate - bytecode and native code implementations, - - if using a non-value layout in an external, you may not use the old-style - unboxed float directive, and - - [@unboxed] is allowed on unboxed types but has no effect. Same is not - true for [@untagged]. -*) - -external f10_1 : int -> bool -> float# = "foo";; -[%%expect{| -Line 1, characters 0-46: -1 | external f10_1 : int -> bool -> float# = "foo";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The native code version of the primitive is mandatory - for types with non-value layouts. -|}];; - -external f10_2 : t_float64 -> int = "foo";; -[%%expect{| -Line 1, characters 0-41: -1 | external f10_2 : t_float64 -> int = "foo";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The native code version of the primitive is mandatory - for types with non-value layouts. -|}];; - -external f10_3 : float -> t_float64 = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-58: -1 | external f10_3 : float -> t_float64 = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_4 : int -> float# -> float = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-62: -1 | external f10_4 : int -> float# -> float = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_5 : float# -> bool -> string = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-64: -1 | external f10_5 : float# -> bool -> string = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_6 : (float#[@unboxed]) -> bool -> string = "foo" "bar";; -[%%expect{| -external f10_6 : float# -> bool -> string = "foo" "bar" -|}];; - -external f10_7 : string -> (float#[@unboxed]) = "foo" "bar";; -[%%expect{| -external f10_7 : string -> float# = "foo" "bar" -|}];; - -external f10_8 : float -> float# = "foo" "bar" [@@unboxed];; -[%%expect{| -external f10_8 : (float [@unboxed]) -> float# = "foo" "bar" -|}];; - -external f10_9 : (float#[@untagged]) -> bool -> string = "foo" "bar";; -[%%expect{| -Line 1, characters 18-24: -1 | external f10_9 : (float#[@untagged]) -> bool -> string = "foo" "bar";; - ^^^^^^ -Error: Don't know how to untag this type. Only int can be untagged. -|}];; - -external f10_10 : string -> (float#[@untagged]) = "foo" "bar";; -[%%expect{| -Line 1, characters 29-35: -1 | external f10_10 : string -> (float#[@untagged]) = "foo" "bar";; - ^^^^^^ -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 = .. -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{| -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 = .. - -type 'a t11_2 += A of int - -type 'a t11_2 += B of 'a;; - -[%%expect{| -type ('a : float64) t11_2 = .. -type 'a t11_2 += A of int -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. *) - -type t11_1 += C of t_float64 * string;; - -[%%expect{| -Line 1, characters 14-37: -1 | type t11_1 += C of t_float64 * string;; - ^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - t_float64, but found boxed argument, string. -|}] - -(***************************************) -(* Test 12: float64 in objects/classes *) - -(* First, disallowed uses: in object types, class parameters, etc. *) -type t12_1 = < x : t_float64 >;; -[%%expect{| -Line 1, characters 15-28: -1 | type t12_1 = < x : t_float64 >;; - ^^^^^^^^^^^^^ -Error: Object field types must have layout value. - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - it's the type of an object field. -|}];; - -type ('a : float64) t12_2 = < x : 'a >;; -[%%expect{| -Line 1, characters 34-36: -1 | type ('a : float64) t12_2 = < x : 'a >;; - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float64) - The layout of 'a is float64, because - of the annotation on 'a in the declaration of the type t12_2. - But the layout of 'a must overlap with value, because - it's the type of an object field. -|}] - -class c12_3 = object method x : t_float64 = assert false end;; -[%%expect{| -Line 1, characters 21-56: -1 | class c12_3 = object method x : t_float64 = assert false end;; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The method x has type t_float64 but is expected to have type - ('a : value) - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - it's the type of an object field. -|}];; - -class ['a] c12_4 = object - method x : 'a t_float64_id -> 'a t_float64_id = assert false -end;; -[%%expect{| -Line 2, characters 13-15: -2 | method x : 'a t_float64_id -> 'a t_float64_id = assert false - ^^ -Error: This type ('a : float64) should be an instance of type ('a0 : value) - The layout of 'a is value, because - it's a type argument to a class constructor. - But the layout of 'a must overlap with float64, because - of the definition of t_float64_id at line 2, characters 0-37. -|}];; - -class c12_5 = object val x : t_float64 = assert false end;; -[%%expect{| -Line 1, characters 25-26: -1 | class c12_5 = object val x : t_float64 = assert false end;; - ^ -Error: Variables bound in a class must have layout value. - The layout of x is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of x must be a sublayout of value, because - it's the type of a class field. -|}];; - -class type c12_6 = object method x : float# end;; -[%%expect{| -Line 1, characters 26-43: -1 | class type c12_6 = object method x : float# end;; - ^^^^^^^^^^^^^^^^^ -Error: The method x has type float# but is expected to have type ('a : value) - The layout of float# is float64, because - it is the primitive float64 type float#. - But the layout of float# must be a sublayout of value, because - it's the type of an object field. -|}];; - -class type c12_7 = object val x : float# end -[%%expect{| -Line 1, characters 26-40: -1 | class type c12_7 = object val x : float# end - ^^^^^^^^^^^^^^ -Error: Variables bound in a class must have layout value. - The layout of x is float64, because - it is the primitive float64 type float#. - But the layout of x must be a sublayout of value, because - it's the type of an instance variable. -|}];; - -class type ['a] c12_8 = object - val x : 'a t_float64_id -> 'a t_float64_id -end -[%%expect{| -Line 2, characters 10-12: -2 | val x : 'a t_float64_id -> 'a t_float64_id - ^^ -Error: This type ('a : float64) should be an instance of type ('a0 : value) - The layout of 'a is value, because - it's a type argument to a class constructor. - But the layout of 'a must overlap with float64, because - of the definition of t_float64_id at line 2, characters 0-37. -|}];; - -(* Second, allowed uses: as method parameters / returns *) -type t12_8 = < f : t_float64 -> t_float64 > -let f12_9 (o : t12_8) x = o#f x -let f12_10 o (y : t_float64) : t_float64 = o#baz y y y;; -class ['a] c12_11 = object - method x : t_float64 -> 'a = assert false -end;; -class ['a] c12_12 = object - method x : 'a -> t_float64 = assert false -end;; -[%%expect{| -type t12_8 = < f : t_float64 -> t_float64 > -val f12_9 : t12_8 -> t_float64 -> t_float64 = -val f12_10 : - < baz : t_float64 -> t_float64 -> t_float64 -> t_float64; .. > -> - t_float64 -> t_float64 = -class ['a] c12_11 : object method x : t_float64 -> 'a end -class ['a] c12_12 : object method x : 'a -> t_float64 end -|}];; - -(* Third, another disallowed use: capture in an object. *) -let f12_13 m1 m2 = object - val f = fun () -> - let _ = f1_1 m1 in - let _ = f1_1 m2 in - () -end;; -[%%expect{| -Line 3, characters 17-19: -3 | let _ = f1_1 m1 in - ^^ -Error: This expression has type ('a : value) - but an expression was expected of type t_float64 - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - it's the type of a variable captured in an object. -|}];; - -let f12_14 (m1 : t_float64) (m2 : t_float64) = object - val f = fun () -> - let _ = f1_1 m1 in - let _ = f1_1 m2 in - () -end;; -[%%expect{| -Line 3, characters 17-19: -3 | let _ = f1_1 m1 in - ^^ -Error: m1 must have a type of layout value because it is captured by an object. - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - it's the type of a variable captured in an object. -|}];; - -(*********************************************************************) -(* Test 13: Ad-hoc polymorphic operations don't work on float64 yet. *) - -(* CR layouts v5: Remember to handle the case of calling these on structures - containing other layouts. *) - -let f13_1 (x : t_float64) = x = x;; -[%%expect{| -Line 1, characters 28-29: -1 | let f13_1 (x : t_float64) = x = x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - of layout requirements from an imported definition. -|}];; - -let f13_2 (x : t_float64) = compare x x;; -[%%expect{| -Line 1, characters 36-37: -1 | let f13_2 (x : t_float64) = compare x x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - of layout requirements from an imported definition. -|}];; - -let f13_3 (x : t_float64) = Marshal.to_bytes x;; -[%%expect{| -Line 1, characters 45-46: -1 | let f13_3 (x : t_float64) = Marshal.to_bytes x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - of layout requirements from an imported definition. -|}];; - -let f13_4 (x : t_float64) = Hashtbl.hash x;; -[%%expect{| -Line 1, characters 41-42: -1 | let f13_4 (x : t_float64) = Hashtbl.hash x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - The layout of t_float64 is float64, because - of the definition of t_float64 at line 1, characters 0-24. - But the layout of t_float64 must be a sublayout of value, because - of layout requirements from an imported definition. -|}];; - -(***********************************************************) -(* Test 14: unboxed float records work like normal records *) - -module FU = Stdlib_upstream_compatible.Float_u - -type t14_1 = { x : float#; y : float# } - -(* pattern matching *) -let f14_1 {x;y} = FU.sub x y - -(* construction *) -let r14 = { x = #3.14; y = #2.72 } - -let sum14_1 = FU.to_float (f14_1 r14) - -(* projection *) -let f14_2 ({y;_} as r) = FU.sub r.x y - -let sum14_2 = FU.to_float (f14_1 r14) - -type t14_2 = { mutable a : float#; b : float#; mutable c : float# } - -let f14_3 ({b; c; _} as r) = - (* pure record update *) - let r' = { r with b = #20.0; c = r.a } in - (* mutation *) - r.a <- FU.sub r.a r'.b; - r'.a <- #42.0; - r' - -let a, b, c, a', b', c' = - let r = {a = #3.1; b = -#0.42; c = #27.7 } in - let r' = f14_3 r in - FU.to_float r.a, - FU.to_float r.b, - FU.to_float r.c, - FU.to_float r'.a, - FU.to_float r'.b, - FU.to_float r'.c - -let f14_4 r = - let {x; y} = r in - FU.add x y - - -[%%expect{| -module FU = Stdlib_upstream_compatible.Float_u -type t14_1 = { x : float#; y : float#; } -val f14_1 : t14_1 -> FU.t = -val r14 : t14_1 = {x = ; y = } -val sum14_1 : float = 0.419999999999999929 -val f14_2 : t14_1 -> FU.t = -val sum14_2 : float = 0.419999999999999929 -type t14_2 = { mutable a : float#; b : float#; mutable c : float#; } -val f14_3 : t14_2 -> t14_2 = -val a : float = -16.9 -val b : float = -0.42 -val c : float = 27.7 -val a' : float = 42. -val b' : float = 20. -val c' : float = 3.1 -val f14_4 : t14_1 -> FU.t = -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-word/basics.ml b/ocaml/testsuite/tests/typing-layouts-word/basics.ml index a105f271f0a..cdf2607fb84 100644 --- a/ocaml/testsuite/tests/typing-layouts-word/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-word/basics.ml @@ -202,8 +202,20 @@ Error: This type ('b : value) should be an instance of type ('a : word) (****************************************************) (* Test 5: Allowed in some structures in typedecls. *) -(* See [basics_alpha.ml] and [basics_beta.ml] for these -- we'll move them back - in once mixed blocks are out of beta. *) +type t5_1 = { x : t_word };; +[%%expect{| +type t5_1 = { x : t_word; } +|}];; + +type t5_2 = { y : int; x : t_word };; +[%%expect{| +type t5_2 = { y : int; x : t_word; } +|}];; + +type t5_2' = { y : string; x : t_word };; +[%%expect{| +type t5_2' = { y : string; x : t_word; } +|}];; (* CR layouts 2.5: allow this *) type t5_3 = { x : t_word } [@@unboxed];; @@ -215,6 +227,34 @@ Error: Type t_word has layout word. Unboxed records may not yet contain types of this layout. |}];; +type t5_4 = A of t_word;; +[%%expect{| +type t5_4 = A of t_word +|}];; + +type t5_5 = A of int * t_word;; +[%%expect{| +type t5_5 = A of int * t_word +|}];; + +type ('a : word) t5_7 = A of int +type ('a : word) t5_8 = A of 'a;; +[%%expect{| +type ('a : word) t5_7 = A of int +type ('a : word) t5_8 = A of 'a +|}] + +(* not allowed: value in flat suffix *) +type 'a t_disallowed = A of t_word * 'a + +[%%expect{| +Line 1, characters 23-39: +1 | type 'a t_disallowed = A of t_word * 'a + ^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, + t_word, but found boxed argument, 'a. +|}] + type t5_6 = A of t_word [@@unboxed];; [%%expect{| Line 1, characters 12-23: @@ -461,10 +501,55 @@ Line 1, characters 29-39: Error: Don't know how to untag this type. Only int can be untagged. |}];; -(***************************************************) -(* Test 11: Allow word in some extensible variants *) +(***********************************************) +(* Test 11: word banned in extensible variants *) + +(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) + +type t11_1 = .. + +type t11_1 += A of t_word;; +[%%expect{| +type t11_1 = .. +Line 3, characters 14-25: +3 | type t11_1 += A of t_word;; + ^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +type t11_1 += B of nativeint#;; +[%%expect{| +Line 1, characters 14-29: +1 | type t11_1 += B of nativeint#;; + ^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] -(* See [basics_alpha.ml] and [basics_beta.ml] *) +type ('a : word) t11_2 = .. + +type 'a t11_2 += A of int + +type 'a t11_2 += B of 'a;; + +[%%expect{| +type ('a : word) t11_2 = .. +type 'a t11_2 += A of int +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 *) +type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + +[%%expect{| +Line 1, characters 17-40: +1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + ^^^^^^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, 'a, + but found boxed argument, 'b. +|}] (***************************************) (* Test 12: word in objects/classes *) diff --git a/ocaml/testsuite/tests/typing-layouts-word/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-word/basics_beta.ml deleted file mode 100644 index 6b581b49c95..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-word/basics_beta.ml +++ /dev/null @@ -1,116 +0,0 @@ -(* TEST - { - flags = "-extension layouts_alpha"; - expect; - }{ - flags = "-extension layouts_beta"; - expect; - } -*) - -(* We should move these back into [basics.ml] once - mixed blocks are out of beta. *) - -type t_word : word -type ('a : word) t_word_id = 'a - -[%%expect{| -type t_word : word -type ('a : word) t_word_id = 'a -|}];; - -(****************************************************) -(* Test 5: Allowed in some structures in typedecls. *) - -type t5_1 = { x : t_word };; -[%%expect{| -type t5_1 = { x : t_word; } -|}];; - -type t5_2 = { y : int; x : t_word };; -[%%expect{| -type t5_2 = { y : int; x : t_word; } -|}];; - -type t5_2' = { y : string; x : t_word };; -[%%expect{| -type t5_2' = { y : string; x : t_word; } -|}];; - -type t5_4 = A of t_word;; -[%%expect{| -type t5_4 = A of t_word -|}];; - -type t5_5 = A of int * t_word;; -[%%expect{| -type t5_5 = A of int * t_word -|}];; - -type ('a : word) t5_7 = A of int -type ('a : word) t5_8 = A of 'a;; -[%%expect{| -type ('a : word) t5_7 = A of int -type ('a : word) t5_8 = A of 'a -|}] - -(* not allowed: value in flat suffix *) -type 'a t_disallowed = A of t_word * 'a - -[%%expect{| -Line 1, characters 23-39: -1 | type 'a t_disallowed = A of t_word * 'a - ^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - t_word, but found boxed argument, 'a. -|}] - -(***************************************************) -(* Test 11: Allow word in some extensible variants *) - -(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) - -type t11_1 = .. - -type t11_1 += A of t_word;; -[%%expect{| -type t11_1 = .. -Line 3, characters 14-25: -3 | type t11_1 += A of t_word;; - ^^^^^^^^^^^ -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}] - -type t11_1 += B of nativeint#;; -[%%expect{| -Line 1, characters 14-29: -1 | type t11_1 += B of nativeint#;; - ^^^^^^^^^^^^^^^ -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}] - -type ('a : word) t11_2 = .. - -type 'a t11_2 += A of int - -type 'a t11_2 += B of 'a;; - -[%%expect{| -type ('a : word) t11_2 = .. -type 'a t11_2 += A of int -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 *) -type 'a t11_2 += C : 'a * 'b -> 'a t11_2 - -[%%expect{| -Line 1, characters 17-40: -1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 - ^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, 'a, - but found boxed argument, 'b. -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-word/parsing.ml b/ocaml/testsuite/tests/typing-layouts-word/parsing.ml index 0d7130191ff..0c510403373 100644 --- a/ocaml/testsuite/tests/typing-layouts-word/parsing.ml +++ b/ocaml/testsuite/tests/typing-layouts-word/parsing.ml @@ -16,20 +16,12 @@ val f : nativeint# -> unit = type t = C of nativeint#;; [%%expect {| -Line 1, characters 9-24: -1 | type t = C of nativeint#;; - ^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t = C of nativeint# |}];; type t = C : nativeint# -> t;; [%%expect {| -Line 1, characters 9-28: -1 | type t = C : nativeint# -> t;; - ^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t = C : nativeint# -> t |}];; (* nativeint# works as an argument to normal type constructors, not just diff --git a/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments.ml b/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments.ml index f96504f125f..e9dea47e12e 100644 --- a/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments.ml +++ b/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments.ml @@ -1,5 +1,13 @@ (* TEST - expect; + { + flags = "-extension layouts_alpha"; + expect; + }{ + flags = "-extension layouts_beta"; + expect; + }{ + expect; + } *) (* For each example with regular variants, this test also includes an example @@ -15,11 +23,7 @@ type t_ext = .. type t_cstr_boxed_float = A of float * float# [%%expect{| -Line 1, characters 26-45: -1 | type t_cstr_boxed_float = A of float * float# - ^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t_cstr_boxed_float = A of float * float# |}];; type t_ext += A of float * float# @@ -107,11 +111,7 @@ Error: Expected all flat constructor arguments after non-value argument, type t_cstr_boxed_float = A of float * float# * int [%%expect{| -Line 1, characters 26-51: -1 | type t_cstr_boxed_float = A of float * float# * int - ^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t_cstr_boxed_float = A of float * float# * int |}];; type t_ext += A of float * float# * int @@ -190,11 +190,7 @@ Error: Expected all flat constructor arguments after non-value argument, type t_cstr_flat_int = A of float# * float# * int [%%expect{| -Line 1, characters 23-49: -1 | type t_cstr_flat_int = A of float# * float# * int - ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t_cstr_flat_int = A of float# * float# * int |}];; type t_ext += A of float# * float# * int @@ -214,11 +210,12 @@ type t_cstr_flat_int_multi = | E of int * float# * int * float# [%%expect{| -Line 2, characters 2-30: -2 | | A of float# * float# * int - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type t_cstr_flat_int_multi = + A of float# * float# * int + | B of int + | C of float# * int + | D of float# * int * float# + | E of int * float# * int * float# |}];; type t_ext += @@ -239,11 +236,7 @@ Error: Extensible types can't have fields of unboxed type. Consider wrapping the type ('a : float64) t_cstr_param1 = A of string * 'a [%%expect{| -Line 1, characters 36-52: -1 | type ('a : float64) t_cstr_param1 = A of string * 'a - ^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type ('a : float64) t_cstr_param1 = A of string * 'a |}];; type ('a : float64) t_cstr_param_ext1 = .. @@ -258,11 +251,7 @@ Error: Extensible types can't have fields of unboxed type. Consider wrapping the type ('a : float64, 'b : immediate) t_cstr_param2 = A of string * 'a * 'b [%%expect{| -Line 1, characters 52-73: -1 | type ('a : float64, 'b : immediate) t_cstr_param2 = A of string * 'a * 'b - ^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type ('a : float64, 'b : immediate) t_cstr_param2 = A of string * 'a * 'b |}];; type ('a : float64, 'b : immediate) t_cstr_param_ext2 = .. @@ -322,11 +311,10 @@ and 'a t_imm = 'a t_immediate_id and ('a : float64, 'b : immediate, 'ptr) t_cstr2 = A of 'ptr * 'a * 'a t_float * 'b * 'b t_imm [%%expect{| -Line 4, characters 2-45: -4 | A of 'ptr * 'a * 'a t_float * 'b * 'b t_imm - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type ('a : float64) t_float = 'a t_float64_id +and ('a : immediate) t_imm = 'a t_immediate_id +and ('a : float64, 'b : immediate, 'ptr) t_cstr2 = + A of 'ptr * 'a * 'a t_float * 'b * 'b t_imm |}];; (* There is a cap on the number of fields in the scannable prefix. *) @@ -379,8 +367,7 @@ Lines 3-36, characters 2-16: 34 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * 35 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * 36 | int * float# -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Mixed constructors may contain at most 254 value fields prior to the flat suffix, but this one contains 255. |}];; type t_ext += @@ -448,11 +435,9 @@ type ('a : any) t_gadt_any = | B : 'b tv -> 'a t_gadt_any [%%expect {| -Line 2, characters 2-30: -2 | | A : 'a tf -> 'a t_gadt_any - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type ('a : any) t_gadt_any = + A : ('a : float64). 'a tf -> 'a t_gadt_any + | B : 'b tv -> 'a t_gadt_any |}] type ('a : any) t_gadt_any_multiple_fields = @@ -460,11 +445,9 @@ type ('a : any) t_gadt_any_multiple_fields = | B : 'b tv * float# -> 'a t_gadt_any_multiple_fields [%%expect {| -Line 2, characters 2-55: -2 | | A : float# * 'a tf -> 'a t_gadt_any_multiple_fields - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +type ('a : any) t_gadt_any_multiple_fields = + A : ('a : float64). float# * 'a tf -> 'a t_gadt_any_multiple_fields + | B : 'b tv * float# -> 'a t_gadt_any_multiple_fields |}] type ('a : any) t_gadt_any_bad = @@ -491,4 +474,3 @@ Line 1, characters 31-41: Error: Type float# has layout float64. Inlined records may not yet contain types of this layout. |}] - diff --git a/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments_beta.ml b/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments_beta.ml deleted file mode 100644 index 8f4c034da53..00000000000 --- a/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments_beta.ml +++ /dev/null @@ -1,469 +0,0 @@ -(* TEST - flags = "-extension layouts_beta"; - expect; -*) - -(* For each example with regular variants, this test also includes an example - with extensible variants. -*) - -type t_ext = .. -[%%expect {| -type t_ext = .. -|}];; - -(* Mixed float-float# constructor args are OK, but the float args aren't flat *) -type t_cstr_boxed_float = A of float * float# - -[%%expect{| -type t_cstr_boxed_float = A of float * float# -|}];; - -type t_ext += A of float * float# - -[%%expect{| -Line 1, characters 14-33: -1 | type t_ext += A of float * float# - ^^^^^^^^^^^^^^^^^^^ -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}];; - -(* The fact that the float args aren't flat is evidenced by the fact this - type decl doesn't type-check. -*) -type t_cstr_boxed_float_bad = A of float# * float - -[%%expect{| -Line 1, characters 30-49: -1 | type t_cstr_boxed_float_bad = A of float# * float - ^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, float. -|}];; - -type t_ext += A of float# * float - -[%%expect{| -Line 1, characters 14-33: -1 | type t_ext += A of float# * float - ^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, float. -|}];; - -(* You can't trick the type-checker by adding more constructors *) -type t_cstr_boxed_float_bad_multi_constr = - | Const - | A of float# * float - -[%%expect{| -Line 3, characters 2-23: -3 | | A of float# * float - ^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, float. -|}];; - -type t_ext += - | Const - | A of float# * float - -[%%expect{| -Line 3, characters 2-23: -3 | | A of float# * float - ^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, float. -|}];; - -(* When a non-float/float# field appears, [float] - fields continue to not be considered flat. *) -type t_cstr_boxed_float_plus_more = - | A of float# * float * int - -[%%expect{| -Line 2, characters 2-29: -2 | | A of float# * float * int - ^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, float. -|}];; - -type t_ext += - | A of float# * float * int - -[%%expect{| -Line 2, characters 2-29: -2 | | A of float# * float * int - ^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, float. -|}];; - -(* [float] appearing as a non-flat field in the value prefix. *) -type t_cstr_boxed_float = A of float * float# * int - -[%%expect{| -type t_cstr_boxed_float = A of float * float# * int -|}];; - -type t_ext += A of float * float# * int - -[%%expect{| -Line 1, characters 14-39: -1 | type t_ext += A of float * float# * int - ^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}];; - -(* The third field can't be flat because a non-float/float# field [d] appears.*) -type t_cstr_multi_boxed_float_bad = A of float * float# * float * int - -[%%expect{| -Line 1, characters 36-69: -1 | type t_cstr_multi_boxed_float_bad = A of float * float# * float * int - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, float. -|}];; - -type t_ext += A of float * float# * float * int - -[%%expect{| -Line 1, characters 14-47: -1 | type t_ext += A of float * float# * float * int - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, float. -|}];; - -(* String can't appear in the flat suffix *) -type t_cstr_flat_string_bad1 = A of float# * string - -[%%expect{| -Line 1, characters 31-51: -1 | type t_cstr_flat_string_bad1 = A of float# * string - ^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, string. -|}];; - -type t_ext += A of float# * string - -[%%expect{| -Line 1, characters 14-34: -1 | type t_ext += A of float# * string - ^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, string. -|}];; - -(* The string can't appear in the flat suffix. *) -type t_cstr_flat_string_bad2 = A of float# * float# * string - -[%%expect{| -Line 1, characters 31-60: -1 | type t_cstr_flat_string_bad2 = A of float# * float# * string - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, string. -|}];; - -type t_ext += A of float# * float# * string - -[%%expect{| -Line 1, characters 14-43: -1 | type t_ext += A of float# * float# * string - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, string. -|}];; - -(* The int [c] can appear in the flat suffix. *) -type t_cstr_flat_int = A of float# * float# * int - -[%%expect{| -type t_cstr_flat_int = A of float# * float# * int -|}];; - -type t_ext += A of float# * float# * int - -[%%expect{| -Line 1, characters 14-40: -1 | type t_ext += A of float# * float# * int - ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}];; - -type t_cstr_flat_int_multi = - | A of float# * float# * int - | B of int - | C of float# * int - | D of float# * int * float# - | E of int * float# * int * float# - -[%%expect{| -type t_cstr_flat_int_multi = - A of float# * float# * int - | B of int - | C of float# * int - | D of float# * int * float# - | E of int * float# * int * float# -|}];; - -type t_ext += - | A of float# * float# * int - | B of int - | C of float# * int - | D of float# * int * float# - | E of int * float# * int * float# - -[%%expect{| -Line 2, characters 2-30: -2 | | A of float# * float# * int - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}];; - -(* Parameterized types *) - -type ('a : float64) t_cstr_param1 = A of string * 'a -[%%expect{| -type ('a : float64) t_cstr_param1 = A of string * 'a -|}];; - -type ('a : float64) t_cstr_param_ext1 = .. -type 'a t_cstr_param_ext1 += A of string * 'a -[%%expect{| -type ('a : float64) t_cstr_param_ext1 = .. -Line 2, characters 29-45: -2 | type 'a t_cstr_param_ext1 += A of string * 'a - ^^^^^^^^^^^^^^^^ -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}];; - -type ('a : float64, 'b : immediate) t_cstr_param2 = A of string * 'a * 'b -[%%expect{| -type ('a : float64, 'b : immediate) t_cstr_param2 = A of string * 'a * 'b -|}];; - -type ('a : float64, 'b : immediate) t_cstr_param_ext2 = .. -type ('a, 'b) t_cstr_param_ext2 += A of string * 'a * 'b;; - -[%%expect{| -type ('a : float64, 'b : immediate) t_cstr_param_ext2 = .. -Line 2, characters 35-56: -2 | type ('a, 'b) t_cstr_param_ext2 += A of string * 'a * 'b;; - ^^^^^^^^^^^^^^^^^^^^^ -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}];; - -type 'a t_cstr_bad_value_after_float = C of float# * 'a - -[%%expect{| -Line 1, characters 39-55: -1 | type 'a t_cstr_bad_value_after_float = C of float# * 'a - ^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, 'a. -|}];; - -(* Recursive groups. There's not a good way to exercise the same functionality - for extensible variants, so we omit that aspect of this test. -*) - -type ('a : float64) t_float64_id = 'a -type ('a : immediate) t_immediate_id = 'a -[%%expect{| -type ('a : float64) t_float64_id = 'a -type ('a : immediate) t_immediate_id = 'a -|}];; - -type 'a t_float = 'a t_float64_id -and 'a t_imm = 'a t_immediate_id -and ('a, 'b, 'ptr) t_cstr1 = A of 'ptr * 'a * 'a t_float * 'b * 'b t_imm -[%%expect{| -Line 3, characters 46-56: -3 | and ('a, 'b, 'ptr) t_cstr1 = A of 'ptr * 'a * 'a t_float * 'b * 'b t_imm - ^^^^^^^^^^ -Error: Layout mismatch in final type declaration consistency check. - This is most often caused by the fact that type inference is not - clever enough to propagate layouts through variables in different - declarations. It is also not clever enough to produce a good error - message, so we'll say this instead: - The layout of 'a is float64, because - of the definition of t_float64_id at line 1, characters 0-37. - But the layout of 'a must overlap with value, because - it instantiates an unannotated type parameter of t_cstr1, defaulted to layout value. - A good next step is to add a layout annotation on a parameter to - the declaration where this error is reported. -|}];; - -type 'a t_float = 'a t_float64_id -and 'a t_imm = 'a t_immediate_id -and ('a : float64, 'b : immediate, 'ptr) t_cstr2 = - A of 'ptr * 'a * 'a t_float * 'b * 'b t_imm -[%%expect{| -type ('a : float64) t_float = 'a t_float64_id -and ('a : immediate) t_imm = 'a t_immediate_id -and ('a : float64, 'b : immediate, 'ptr) t_cstr2 = - A of 'ptr * 'a * 'a t_float * 'b * 'b t_imm -|}];; - -(* There is a cap on the number of fields in the scannable prefix. *) -type ptr = string -type t_cstr_capped = - A of - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * - int * float# -[%%expect{| -type ptr = string -Lines 3-36, characters 2-16: - 3 | ..A of - 4 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - 5 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - 6 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - 7 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * -... -33 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * -34 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * -35 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * -36 | int * float# -Error: Mixed constructors may contain at most 254 value fields prior to the flat suffix, but this one contains 255. -|}];; - -type t_ext += - A of - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - ptr * ptr * ptr * ptr * ptr * ptr * ptr * - int * float# -[%%expect{| -Lines 2-35, characters 2-16: - 2 | ..A of - 3 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - 4 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - 5 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * - 6 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * -... -32 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * -33 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * -34 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * -35 | int * float# -Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. -|}];; - -(* GADT syntax *) - -type ('a : float64) tf : float64 -type ('a : value) tv : value - -[%%expect {| -type ('a : float64) tf : float64 -type 'a tv : value -|}] - -type ('a : any) t_gadt_any = - | A : 'a tf -> 'a t_gadt_any - | B : 'b tv -> 'a t_gadt_any - -[%%expect {| -type ('a : any) t_gadt_any = - A : ('a : float64). 'a tf -> 'a t_gadt_any - | B : 'b tv -> 'a t_gadt_any -|}] - -type ('a : any) t_gadt_any_multiple_fields = - | A : float# * 'a tf -> 'a t_gadt_any_multiple_fields - | B : 'b tv * float# -> 'a t_gadt_any_multiple_fields - -[%%expect {| -type ('a : any) t_gadt_any_multiple_fields = - A : ('a : float64). float# * 'a tf -> 'a t_gadt_any_multiple_fields - | B : 'b tv * float# -> 'a t_gadt_any_multiple_fields -|}] - -type ('a : any) t_gadt_any_bad = - | A : float# * 'a tv -> 'a t_gadt_any_bad - -[%%expect{| -Line 2, characters 2-43: -2 | | A : float# * 'a tv -> 'a t_gadt_any_bad - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Expected all flat constructor arguments after non-value argument, - float#, but found boxed argument, 'a tv. -|}] - -(* Inlined record syntax *) - -(* it just isn't supported yet *) - -type t_inlined_record = A of { x : float# } - -[%%expect{| -Line 1, characters 31-41: -1 | type t_inlined_record = A of { x : float# } - ^^^^^^^^^^ -Error: Type float# has layout float64. - Inlined records may not yet contain types of this layout. -|}] diff --git a/ocaml/testsuite/tests/typing-layouts/mixed_records.ml b/ocaml/testsuite/tests/typing-layouts/mixed_records.ml index 742133b82ec..10b88ad1e73 100644 --- a/ocaml/testsuite/tests/typing-layouts/mixed_records.ml +++ b/ocaml/testsuite/tests/typing-layouts/mixed_records.ml @@ -1,5 +1,13 @@ (* TEST - expect; + { + flags = "-extension layouts_alpha"; + expect; + }{ + flags = "-extension layouts_beta"; + expect; + }{ + expect; + } *) (* Mixed float-float# blocks are always OK. *) @@ -9,13 +17,7 @@ type t = } [%%expect{| -Lines 1-4, characters 0-3: -1 | type t = -2 | { a : float; -3 | b : float#; -4 | } -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type t = { a : float; b : float#; } |}];; (* Mixed float-float# blocks are always OK. *) @@ -25,13 +27,7 @@ type t = } [%%expect{| -Lines 1-4, characters 0-3: -1 | type t = -2 | { a : float#; -3 | b : float; -4 | } -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type t = { a : float#; b : float; } |}];; (* When a non-float/float# field appears, [float] @@ -58,14 +54,7 @@ type t = } [%%expect{| -Lines 1-5, characters 0-3: -1 | type t = -2 | { a : float; -3 | b : float#; -4 | c : int; -5 | } -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type t = { a : float; b : float#; c : int; } |}];; (* The field [c] can't be flat because a non-float/float# field [d] appears. *) @@ -108,14 +97,7 @@ type t = } [%%expect{| -Lines 1-5, characters 0-3: -1 | type t = -2 | { f1 : float#; -3 | f2 : float#; -4 | f3 : float; -5 | } -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type t = { f1 : float#; f2 : float#; f3 : float; } |}];; (* The string [f3] can't appear in the flat suffix. *) @@ -141,34 +123,19 @@ type t = } [%%expect{| -Lines 1-5, characters 0-3: -1 | type t = -2 | { a : float#; -3 | b : float#; -4 | c : int; -5 | } -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type t = { a : float#; b : float#; c : int; } |}];; (* Parameterized types *) type ('a : float64) t = { x : string; y : 'a } [%%expect{| -Line 1, characters 0-46: -1 | type ('a : float64) t = { x : string; y : 'a } - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type ('a : float64) t = { x : string; y : 'a; } |}];; type ('a : float64, 'b : immediate) t = { x : string; y : 'a; z : 'b } [%%expect{| -Line 1, characters 0-70: -1 | type ('a : float64, 'b : immediate) t = { x : string; y : 'a; z : 'b } - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type ('a : float64, 'b : immediate) t = { x : string; y : 'a; z : 'b; } |}];; (* Recursive groups *) @@ -206,11 +173,15 @@ and 'a t_imm = 'a t_immediate_id and ('a : float64, 'b : immediate, 'ptr) t = {ptr : 'ptr; x : 'a; y : 'a t_float; z : 'b; w : 'b t_imm} [%%expect{| -Lines 3-4, characters 0-60: -3 | and ('a : float64, 'b : immediate, 'ptr) t = -4 | {ptr : 'ptr; x : 'a; y : 'a t_float; z : 'b; w : 'b t_imm} -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +type ('a : float64) t_float = 'a t_float64_id +and ('a : immediate) t_imm = 'a t_immediate_id +and ('a : float64, 'b : immediate, 'ptr) t = { + ptr : 'ptr; + x : 'a; + y : 'a t_float; + z : 'b; + w : 'b t_imm; +} |}];; @@ -265,7 +236,5 @@ Lines 2-37, characters 0-3: 35 | x249:ptr; x250:ptr; x251:ptr; x252:ptr; x253:ptr; x254:ptr; x255:ptr; 36 | value_but_flat:int; unboxed:float#; 37 | } -Error: The enabled layouts extension does not allow for mixed records. - You must enable -extension layouts_beta to use this feature. +Error: Mixed records may contain at most 254 value fields prior to the flat suffix, but this one contains 255. |}];; - diff --git a/ocaml/testsuite/tests/typing-layouts/mixed_records_beta.ml b/ocaml/testsuite/tests/typing-layouts/mixed_records_beta.ml deleted file mode 100644 index c9d956055d2..00000000000 --- a/ocaml/testsuite/tests/typing-layouts/mixed_records_beta.ml +++ /dev/null @@ -1,233 +0,0 @@ -(* TEST - flags = "-extension layouts_beta"; - expect; -*) - -(* Mixed float-float# blocks are always OK. *) -type t = - { a : float; - b : float#; - } - -[%%expect{| -type t = { a : float; b : float#; } -|}];; - -(* Mixed float-float# blocks are always OK. *) -type t = - { a : float#; - b : float; - } - -[%%expect{| -type t = { a : float#; b : float; } -|}];; - -(* When a non-float/float# field appears, [float] - fields are no longer considered flat. *) -type t = - { a : float#; - b : float; - c : int; - } - -[%%expect{| -Line 3, characters 4-14: -3 | b : float; - ^^^^^^^^^^ -Error: Expected all flat fields after non-value field, a, - but found boxed field, b. -|}];; - -(* [float] appearing as a non-flat field in the value prefix. *) -type t = - { a : float; - b : float#; - c : int; - } - -[%%expect{| -type t = { a : float; b : float#; c : int; } -|}];; - -(* The field [c] can't be flat because a non-float/float# field [d] appears. *) -type t = - { a : float; - b : float#; - c : float; - d : int; - } - -[%%expect{| -Line 4, characters 4-14: -4 | c : float; - ^^^^^^^^^^ -Error: Expected all flat fields after non-value field, b, - but found boxed field, c. -|}];; - -(* String can't appear in the flat suffix *) -type t = - { a : float#; - b : string; - } - -[%%expect{| -Line 3, characters 4-15: -3 | b : string; - ^^^^^^^^^^^ -Error: Expected all flat fields after non-value field, a, - but found boxed field, b. -|}];; - -(* [f3] can be flat because all other fields are float/float#, - so it can appear in the flat suffix. - *) -type t = - { f1 : float#; - f2 : float#; - f3 : float; - } - -[%%expect{| -type t = { f1 : float#; f2 : float#; f3 : float; } -|}];; - -(* The string [f3] can't appear in the flat suffix. *) -type t = - { f1 : float#; - f2 : float#; - f3 : string; - } - -[%%expect{| -Line 4, characters 4-16: -4 | f3 : string; - ^^^^^^^^^^^^ -Error: Expected all flat fields after non-value field, f1, - but found boxed field, f3. -|}];; - -(* The int [c] can appear in the flat suffix. *) -type t = - { a : float#; - b : float#; - c : int; - } - -[%%expect{| -type t = { a : float#; b : float#; c : int; } -|}];; - -(* Parameterized types *) - -type ('a : float64) t = { x : string; y : 'a } -[%%expect{| -type ('a : float64) t = { x : string; y : 'a; } -|}];; - -type ('a : float64, 'b : immediate) t = { x : string; y : 'a; z : 'b } -[%%expect{| -type ('a : float64, 'b : immediate) t = { x : string; y : 'a; z : 'b; } -|}];; - -(* Recursive groups *) - -type ('a : float64) t_float64_id = 'a -type ('a : immediate) t_immediate_id = 'a -[%%expect{| -type ('a : float64) t_float64_id = 'a -type ('a : immediate) t_immediate_id = 'a -|}];; - -type 'a t_float = 'a t_float64_id -and 'a t_imm = 'a t_immediate_id -and ('a, 'b, 'ptr) t = - {ptr : 'ptr; x : 'a; y : 'a t_float; z : 'b; w : 'b t_imm} -[%%expect{| -Line 4, characters 27-37: -4 | {ptr : 'ptr; x : 'a; y : 'a t_float; z : 'b; w : 'b t_imm} - ^^^^^^^^^^ -Error: Layout mismatch in final type declaration consistency check. - This is most often caused by the fact that type inference is not - clever enough to propagate layouts through variables in different - declarations. It is also not clever enough to produce a good error - message, so we'll say this instead: - The layout of 'a is float64, because - of the definition of t_float64_id at line 1, characters 0-37. - But the layout of 'a must overlap with value, because - it instantiates an unannotated type parameter of t, defaulted to layout value. - A good next step is to add a layout annotation on a parameter to - the declaration where this error is reported. -|}];; - -type 'a t_float = 'a t_float64_id -and 'a t_imm = 'a t_immediate_id -and ('a : float64, 'b : immediate, 'ptr) t = - {ptr : 'ptr; x : 'a; y : 'a t_float; z : 'b; w : 'b t_imm} -[%%expect{| -type ('a : float64) t_float = 'a t_float64_id -and ('a : immediate) t_imm = 'a t_immediate_id -and ('a : float64, 'b : immediate, 'ptr) t = { - ptr : 'ptr; - x : 'a; - y : 'a t_float; - z : 'b; - w : 'b t_imm; -} -|}];; - - -(* There is a cap on the number of fields in the scannable prefix. *) -type ptr = string -type t = - { - x1:ptr; x2:ptr; x3:ptr; x4:ptr; x5:ptr; x6:ptr; x7:ptr; x8:ptr; - x9:ptr; x10:ptr; x11:ptr; x12:ptr; x13:ptr; x14:ptr; x15:ptr; x16:ptr; - x17:ptr; x18:ptr; x19:ptr; x20:ptr; x21:ptr; x22:ptr; x23:ptr; x24:ptr; - x25:ptr; x26:ptr; x27:ptr; x28:ptr; x29:ptr; x30:ptr; x31:ptr; x32:ptr; - x33:ptr; x34:ptr; x35:ptr; x36:ptr; x37:ptr; x38:ptr; x39:ptr; x40:ptr; - x41:ptr; x42:ptr; x43:ptr; x44:ptr; x45:ptr; x46:ptr; x47:ptr; x48:ptr; - x49:ptr; x50:ptr; x51:ptr; x52:ptr; x53:ptr; x54:ptr; x55:ptr; x56:ptr; - x57:ptr; x58:ptr; x59:ptr; x60:ptr; x61:ptr; x62:ptr; x63:ptr; x64:ptr; - x65:ptr; x66:ptr; x67:ptr; x68:ptr; x69:ptr; x70:ptr; x71:ptr; x72:ptr; - x73:ptr; x74:ptr; x75:ptr; x76:ptr; x77:ptr; x78:ptr; x79:ptr; x80:ptr; - x81:ptr; x82:ptr; x83:ptr; x84:ptr; x85:ptr; x86:ptr; x87:ptr; x88:ptr; - x89:ptr; x90:ptr; x91:ptr; x92:ptr; x93:ptr; x94:ptr; x95:ptr; x96:ptr; - x97:ptr; x98:ptr; x99:ptr; x100:ptr; x101:ptr; x102:ptr; x103:ptr; x104:ptr; - x105:ptr; x106:ptr; x107:ptr; x108:ptr; x109:ptr; x110:ptr; x111:ptr; x112:ptr; - x113:ptr; x114:ptr; x115:ptr; x116:ptr; x117:ptr; x118:ptr; x119:ptr; x120:ptr; - x121:ptr; x122:ptr; x123:ptr; x124:ptr; x125:ptr; x126:ptr; x127:ptr; x128:ptr; - x129:ptr; x130:ptr; x131:ptr; x132:ptr; x133:ptr; x134:ptr; x135:ptr; x136:ptr; - x137:ptr; x138:ptr; x139:ptr; x140:ptr; x141:ptr; x142:ptr; x143:ptr; x144:ptr; - x145:ptr; x146:ptr; x147:ptr; x148:ptr; x149:ptr; x150:ptr; x151:ptr; x152:ptr; - x153:ptr; x154:ptr; x155:ptr; x156:ptr; x157:ptr; x158:ptr; x159:ptr; x160:ptr; - x161:ptr; x162:ptr; x163:ptr; x164:ptr; x165:ptr; x166:ptr; x167:ptr; x168:ptr; - x169:ptr; x170:ptr; x171:ptr; x172:ptr; x173:ptr; x174:ptr; x175:ptr; x176:ptr; - x177:ptr; x178:ptr; x179:ptr; x180:ptr; x181:ptr; x182:ptr; x183:ptr; x184:ptr; - x185:ptr; x186:ptr; x187:ptr; x188:ptr; x189:ptr; x190:ptr; x191:ptr; x192:ptr; - x193:ptr; x194:ptr; x195:ptr; x196:ptr; x197:ptr; x198:ptr; x199:ptr; x200:ptr; - x201:ptr; x202:ptr; x203:ptr; x204:ptr; x205:ptr; x206:ptr; x207:ptr; x208:ptr; - x209:ptr; x210:ptr; x211:ptr; x212:ptr; x213:ptr; x214:ptr; x215:ptr; x216:ptr; - x217:ptr; x218:ptr; x219:ptr; x220:ptr; x221:ptr; x222:ptr; x223:ptr; x224:ptr; - x225:ptr; x226:ptr; x227:ptr; x228:ptr; x229:ptr; x230:ptr; x231:ptr; x232:ptr; - x233:ptr; x234:ptr; x235:ptr; x236:ptr; x237:ptr; x238:ptr; x239:ptr; x240:ptr; - x241:ptr; x242:ptr; x243:ptr; x244:ptr; x245:ptr; x246:ptr; x247:ptr; x248:ptr; - x249:ptr; x250:ptr; x251:ptr; x252:ptr; x253:ptr; x254:ptr; x255:ptr; - value_but_flat:int; unboxed:float#; - } -[%%expect{| -type ptr = string -Lines 2-37, characters 0-3: - 2 | type t = - 3 | { - 4 | x1:ptr; x2:ptr; x3:ptr; x4:ptr; x5:ptr; x6:ptr; x7:ptr; x8:ptr; - 5 | x9:ptr; x10:ptr; x11:ptr; x12:ptr; x13:ptr; x14:ptr; x15:ptr; x16:ptr; - 6 | x17:ptr; x18:ptr; x19:ptr; x20:ptr; x21:ptr; x22:ptr; x23:ptr; x24:ptr; -... -34 | x241:ptr; x242:ptr; x243:ptr; x244:ptr; x245:ptr; x246:ptr; x247:ptr; x248:ptr; -35 | x249:ptr; x250:ptr; x251:ptr; x252:ptr; x253:ptr; x254:ptr; x255:ptr; -36 | value_but_flat:int; unboxed:float#; -37 | } -Error: Mixed records may contain at most 254 value fields prior to the flat suffix, but this one contains 255. -|}];; diff --git a/ocaml/typing/typedecl.ml b/ocaml/typing/typedecl.ml index 16831c1a4d3..f3e52b49be1 100644 --- a/ocaml/typing/typedecl.ml +++ b/ocaml/typing/typedecl.ml @@ -1181,7 +1181,7 @@ let assert_mixed_product_support = the all-0 pattern, and we must subtract 2 instead. *) let max_value_prefix_len = (1 lsl required_reserved_header_bits) - 2 in fun loc mixed_product_kind ~value_prefix_len -> - let required_layouts_level = Language_extension.Beta in + let required_layouts_level = Language_extension.Stable in if not (Language_extension.is_at_least Layouts required_layouts_level) then raise (Error (loc, Illegal_mixed_product (Insufficient_level { required_layouts_level;