Skip to content
Merged
Show file tree
Hide file tree
Changes from 13 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@
#### :bug: Bug fix

- Fix result examples. https://github.com/rescript-lang/rescript/pull/7914
- Make inline record fields that overlap with a variant's tag a compile error. https://github.com/rescript-lang/rescript/pull/7875

#### :memo: Documentation

Expand Down
39 changes: 39 additions & 0 deletions compiler/ml/ast_untagged_variants.ml
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,7 @@ type error =
| Duplicated_bs_as
| InvalidVariantTagAnnotation
| InvalidUntaggedVariantDefinition of untagged_error
| TagFieldNameConflict of string * string * string
exception Error of Location.t * error

let report_error ppf =
Expand Down Expand Up @@ -90,6 +91,12 @@ let report_error ppf =
| DuplicateLiteral s -> "Duplicate literal " ^ s ^ "."
| ConstructorMoreThanOneArg name ->
"Constructor " ^ name ^ " has more than one argument.")
| TagFieldNameConflict (constructor_name, field_name, runtime_value) ->
fprintf ppf
"Constructor %s: the @tag name \"%s\" conflicts with the runtime value \
of inline record field \"%s\". Use a different @tag name or rename the \
field."
constructor_name runtime_value field_name

(* Type of the runtime representation of an untagged block (case with payoad) *)
type block_type =
Expand Down Expand Up @@ -462,12 +469,44 @@ let names_from_type_variant ?(is_untagged_def = false) ~env
let blocks = Ext_array.reverse_of_list blocks in
Some {consts; blocks}

let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) =
List.iter
(fun (cstr : Types.constructor_declaration) ->
let constructor_name = Ident.name cstr.cd_id in
let effective_tag_name =
match process_tag_name cstr.cd_attributes with
| Some explicit_tag -> explicit_tag
| None -> constructor_name
in
match cstr.cd_args with
| Cstr_record fields ->
List.iter
(fun (field : Types.label_declaration) ->
let field_name = Ident.name field.ld_id in
let effective_field_name =
match process_tag_type field.ld_attributes with
| Some (String as_name) -> as_name
(* @as payload types other than string have no effect on record fields *)
| Some _ | None -> field_name
in
(* Check if effective field name conflicts with tag *)
if effective_field_name = effective_tag_name then
raise
(Error
( cstr.cd_loc,
TagFieldNameConflict
(constructor_name, field_name, effective_field_name) )))
fields
| _ -> ())
cstrs

type well_formedness_check = {
is_untagged_def: bool;
cstrs: Types.constructor_declaration list;
}

let check_well_formed ~env {is_untagged_def; cstrs} =
check_tag_field_conflicts cstrs;
ignore (names_from_type_variant ~env ~is_untagged_def cstrs)

let has_undefined_literal attrs = process_tag_type attrs = Some Undefined
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@

We've found a bug for you!
/.../fixtures/duplicate_as_tag_inline_record.res:1:35-37

1 │ type animal = Cat({@as("catName") @as("catName2") name: string})
2 │

duplicate @as
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@

We've found a bug for you!
/.../fixtures/variant_tag_overlaps_with_field.res:2:15-33

1 │ @tag("name")
2 │ type animal = Cat({name: string})
3 │
4 │ let cat = Cat({name: "my cat"})

Constructor Cat: the @tag name "name" conflicts with the runtime value of inline record field "name". Use a different @tag name or rename the field.
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@

We've found a bug for you!
/.../fixtures/variant_tag_overlaps_with_field_as.res:2:15-48

1 │ @tag("name")
2 │ type animal = Cat({@as("name") catName: string})
3 │
4 │ let cat = Cat({catName: "my cat"})

Constructor Cat: the @tag name "name" conflicts with the runtime value of inline record field "catName". Use a different @tag name or rename the field.
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
type animal = Cat({@as("catName") @as("catName2") name: string})
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
@tag("name")
type animal = Cat({name: string})

let cat = Cat({name: "my cat"})
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
@tag("name")
type animal = Cat({@as("name") catName: string})

let cat = Cat({catName: "my cat"})
Loading