Skip to content

Commit adb55d0

Browse files
committed
Check the runtime representation of variants matches implementation and interface.
``` // module M : { // @tag("abc") // type t = | A(int) // } = // { // type t = | A(int) // } module M : { type t = | @as("abc") A } = { type t = | A } ```
1 parent a51e799 commit adb55d0

File tree

3 files changed

+24
-0
lines changed

3 files changed

+24
-0
lines changed

CHANGELOG.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@
1515
#### :bug: Bug Fix
1616

1717
- Fix accidental removal of `Belt.Result.Ok` and `Belt.Result.Error` constructors in rc.5 https://github.com/rescript-lang/rescript-compiler/pull/6514
18+
- Add missing check that the runtime representation of variants matches implementation and interface. https://github.com/rescript-lang/rescript-compiler/pull/6513/files
1819

1920
# 11.0.0-rc.7
2021

jscomp/ml/includecore.ml

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -139,6 +139,8 @@ type type_mismatch =
139139
| Record_representation of record_representation * record_representation
140140
| Unboxed_representation of bool (* true means second one is unboxed *)
141141
| Immediate
142+
| Tag_name
143+
| Variant_representation of Ident.t
142144

143145
let report_type_mismatch0 first second decl ppf err =
144146
let pr fmt = Format.fprintf ppf fmt in
@@ -183,6 +185,9 @@ let report_type_mismatch0 first second decl ppf err =
183185
(if b then second else first) decl
184186
"uses unboxed representation"
185187
| Immediate -> pr "%s is not an immediate type" first
188+
| Tag_name -> pr "Their @tag annotations differ"
189+
| Variant_representation s ->
190+
pr "The internal representations for case %s are not equal" (Ident.name s)
186191

187192
let report_type_mismatch first second decl ppf =
188193
List.iter
@@ -232,6 +237,17 @@ and compare_variants ~loc env params1 params2 n
232237
compare_constructor_arguments ~loc env cd1.cd_id
233238
params1 params2 cd1.cd_args cd2.cd_args
234239
in
240+
let r =
241+
if r <> [] then r
242+
else match Ast_untagged_variants.is_nullary_variant cd1.cd_args with
243+
| true ->
244+
let tag_type1 = Ast_untagged_variants.process_tag_type cd1.cd_attributes in
245+
let tag_type2 = Ast_untagged_variants.process_tag_type cd2.cd_attributes in
246+
if tag_type1 <> tag_type2 then [Variant_representation cd1.cd_id]
247+
else []
248+
| false ->
249+
r
250+
in
235251
if r <> [] then r
236252
else compare_variants ~loc env params1 params2 (n+1) rem1 rem2
237253
end
@@ -320,6 +336,11 @@ let type_declarations ?(equality = false) ~loc env name decl1 id decl2 =
320336
| _ -> []
321337
in
322338
if err <> [] then err else
339+
let err =
340+
let tag1 = Ast_untagged_variants.process_tag_name decl1.type_attributes in
341+
let tag2 = Ast_untagged_variants.process_tag_name decl2.type_attributes in
342+
if tag1 <> tag2 then [Tag_name] else err in
343+
if err <> [] then err else
323344
let err = match (decl1.type_kind, decl2.type_kind) with
324345
(_, Type_abstract) -> []
325346
| (Type_variant cstrs1, Type_variant cstrs2) ->

jscomp/ml/includecore.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,8 @@ type type_mismatch =
3535
| Record_representation of record_representation * record_representation
3636
| Unboxed_representation of bool
3737
| Immediate
38+
| Tag_name
39+
| Variant_representation of Ident.t
3840

3941
val value_descriptions:
4042
loc:Location.t -> Env.t -> Ident.t ->

0 commit comments

Comments
 (0)