diff --git a/CHANGELOG.md b/CHANGELOG.md index 5a6468049e..782189f232 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,7 @@ #### :bug: Bug Fix - Fix accidental removal of `Belt.Result.Ok` and `Belt.Result.Error` constructors in rc.5 https://github.com/rescript-lang/rescript-compiler/pull/6514 +- Add missing check that the runtime representation of variants matches implementation and interface. https://github.com/rescript-lang/rescript-compiler/pull/6513/files # 11.0.0-rc.7 diff --git a/jscomp/ml/includecore.ml b/jscomp/ml/includecore.ml index 2b8039f46e..8a3eb04714 100644 --- a/jscomp/ml/includecore.ml +++ b/jscomp/ml/includecore.ml @@ -139,6 +139,8 @@ type type_mismatch = | Record_representation of record_representation * record_representation | Unboxed_representation of bool (* true means second one is unboxed *) | Immediate + | Tag_name + | Variant_representation of Ident.t let report_type_mismatch0 first second decl ppf err = let pr fmt = Format.fprintf ppf fmt in @@ -183,6 +185,9 @@ let report_type_mismatch0 first second decl ppf err = (if b then second else first) decl "uses unboxed representation" | Immediate -> pr "%s is not an immediate type" first + | Tag_name -> pr "Their @tag annotations differ" + | Variant_representation s -> + pr "The internal representations for case %s are not equal" (Ident.name s) let report_type_mismatch first second decl ppf = List.iter @@ -232,6 +237,17 @@ and compare_variants ~loc env params1 params2 n compare_constructor_arguments ~loc env cd1.cd_id params1 params2 cd1.cd_args cd2.cd_args in + let r = + if r <> [] then r + else match Ast_untagged_variants.is_nullary_variant cd1.cd_args with + | true -> + let tag_type1 = Ast_untagged_variants.process_tag_type cd1.cd_attributes in + let tag_type2 = Ast_untagged_variants.process_tag_type cd2.cd_attributes in + if tag_type1 <> tag_type2 then [Variant_representation cd1.cd_id] + else [] + | false -> + r + in if r <> [] then r else compare_variants ~loc env params1 params2 (n+1) rem1 rem2 end @@ -320,6 +336,11 @@ let type_declarations ?(equality = false) ~loc env name decl1 id decl2 = | _ -> [] in if err <> [] then err else + let err = + let tag1 = Ast_untagged_variants.process_tag_name decl1.type_attributes in + let tag2 = Ast_untagged_variants.process_tag_name decl2.type_attributes in + if tag1 <> tag2 then [Tag_name] else err in + if err <> [] then err else let err = match (decl1.type_kind, decl2.type_kind) with (_, Type_abstract) -> [] | (Type_variant cstrs1, Type_variant cstrs2) -> diff --git a/jscomp/ml/includecore.mli b/jscomp/ml/includecore.mli index 1f4cffc31c..2908a07b3c 100644 --- a/jscomp/ml/includecore.mli +++ b/jscomp/ml/includecore.mli @@ -35,6 +35,8 @@ type type_mismatch = | Record_representation of record_representation * record_representation | Unboxed_representation of bool | Immediate + | Tag_name + | Variant_representation of Ident.t val value_descriptions: loc:Location.t -> Env.t -> Ident.t ->