Disallow non-variant spreads in variants (#6980)

* disallow non-variant spreads in variants

* changelog

* undo formatting in changelog

* run make lib

* changelog

* fix

* changelog

Author: zth

CHANGELOG.md

@@ -30,6 +30,7 @@
 - Fix incorrect format of function under unary operator. https://github.com/rescript-lang/rescript-compiler/pull/6953
 - Fix incorrect incorrect printing of module binding with signature. https://github.com/rescript-lang/rescript-compiler/pull/6963
 - Fix incorrect printing of external with `@as` attribute and `_` placholder (fixed argument). https://github.com/rescript-lang/rescript-compiler/pull/6970
+- Disallow spreading anything but regular variants inside of other variants. https://github.com/rescript-lang/rescript-compiler/pull/6980
 
 #### :house: Internal
 
@@ -2607,4 +2608,4 @@ Features:
 
 # 1.0.0
 
-Initial release
+Initial release

jscomp/build_tests/super_errors/expected/variant_spread_abstract_type.res.expected

@@ -0,0 +1,9 @@
+
+  We've found a bug for you!
+  /.../fixtures/variant_spread_abstract_type.res:2:15
+
+  1 │ type a
+  2 │ type b = | ...a | Other
+  3 │ 
+
+  This type is not a valid type to spread. It's only possible to spread other variants.

jscomp/build_tests/super_errors/expected/variant_spread_extensible_variant.res.expected

@@ -0,0 +1,9 @@
+
+  We've found a bug for you!
+  /.../fixtures/variant_spread_extensible_variant.res:2:15
+
+  1 │ type a = ..
+  2 │ type b = | ...a | Other
+  3 │ 
+
+  This type is not a valid type to spread. It's only possible to spread other variants.

jscomp/build_tests/super_errors/fixtures/variant_spread_abstract_type.res

@@ -0,0 +1,2 @@
+type a
+type b = | ...a | Other

jscomp/build_tests/super_errors/fixtures/variant_spread_extensible_variant.res

@@ -0,0 +1,2 @@
+type a = ..
+type b = | ...a | Other

jscomp/ml/typedecl.ml

@@ -2142,6 +2142,8 @@ let report_error ppf = function
       ^ other_variant_text
       ^ ". Both variants must have the same @tag attribute configuration, or no \
         @tag attribute at all")
+  | Variant_spread_fail Variant_type_spread.InvalidType ->
+    fprintf ppf "@[This type is not a valid type to spread. It's only possible to spread other variants.@]"
   | Variant_spread_fail Variant_type_spread.CouldNotFindType ->
     fprintf ppf "@[This type could not be found. It's only possible to spread variants that are known as the spread happens. This means for example that you can't spread variants in recursive definitions.@]"
   | Variant_spread_fail Variant_type_spread.HasTypeParams ->

jscomp/ml/variant_type_spread.ml

@@ -4,6 +4,7 @@ let mk_constructor_comes_from_spread_attr () : Parsetree.attribute =
 type variant_type_spread_error =
   | CouldNotFindType
   | HasTypeParams
+  | InvalidType
   | DuplicateConstructor of {
       variant_with_overlapping_constructor: string;
       overlapping_constructor_name: string;
@@ -31,6 +32,7 @@ let map_constructors ~(sdecl : Parsetree.type_declaration) ~all_constructors env
     in
 
     match type_decl with
+    | {type_kind = Type_variant [] } -> raise (VariantTypeSpreadError (loc.loc, InvalidType))
     | {type_kind = Type_variant cstrs; type_attributes; type_params} ->
       if List.length type_params > 0 then
         raise (VariantTypeSpreadError (loc.loc, HasTypeParams));
@@ -83,7 +85,7 @@ let map_constructors ~(sdecl : Parsetree.type_declaration) ~all_constructors env
                     pcd_args = Pcstr_tuple [];
                     pcd_name = Location.mkloc cstr.cd_id.name cstr.cd_loc;
                   }))
-    | _ -> [c])
+    | _ -> raise (VariantTypeSpreadError (loc.loc, InvalidType)))
   | _ ->
     Hashtbl.add all_constructors c.pcd_name.txt ();
     [c]