diff --git a/CHANGELOG.md b/CHANGELOG.md index 4c7c199062..5c65ccc2f0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 0a8de20d52..9cb7d015c8 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -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 = @@ -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 = @@ -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 diff --git a/tests/build_tests/super_errors/expected/duplicate_as_tag_inline_record.res.expected b/tests/build_tests/super_errors/expected/duplicate_as_tag_inline_record.res.expected new file mode 100644 index 0000000000..36139490cb --- /dev/null +++ b/tests/build_tests/super_errors/expected/duplicate_as_tag_inline_record.res.expected @@ -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 \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/variant_tag_overlaps_with_field.res.expected b/tests/build_tests/super_errors/expected/variant_tag_overlaps_with_field.res.expected new file mode 100644 index 0000000000..5add1b8454 --- /dev/null +++ b/tests/build_tests/super_errors/expected/variant_tag_overlaps_with_field.res.expected @@ -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. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/variant_tag_overlaps_with_field_as.res.expected b/tests/build_tests/super_errors/expected/variant_tag_overlaps_with_field_as.res.expected new file mode 100644 index 0000000000..5ad9cf2622 --- /dev/null +++ b/tests/build_tests/super_errors/expected/variant_tag_overlaps_with_field_as.res.expected @@ -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. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/duplicate_as_tag_inline_record.res b/tests/build_tests/super_errors/fixtures/duplicate_as_tag_inline_record.res new file mode 100644 index 0000000000..2d37642974 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/duplicate_as_tag_inline_record.res @@ -0,0 +1 @@ +type animal = Cat({@as("catName") @as("catName2") name: string}) diff --git a/tests/build_tests/super_errors/fixtures/variant_tag_overlaps_with_field.res b/tests/build_tests/super_errors/fixtures/variant_tag_overlaps_with_field.res new file mode 100644 index 0000000000..12bc1b2648 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/variant_tag_overlaps_with_field.res @@ -0,0 +1,4 @@ +@tag("name") +type animal = Cat({name: string}) + +let cat = Cat({name: "my cat"}) diff --git a/tests/build_tests/super_errors/fixtures/variant_tag_overlaps_with_field_as.res b/tests/build_tests/super_errors/fixtures/variant_tag_overlaps_with_field_as.res new file mode 100644 index 0000000000..d97e5719bc --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/variant_tag_overlaps_with_field_as.res @@ -0,0 +1,4 @@ +@tag("name") +type animal = Cat({@as("name") catName: string}) + +let cat = Cat({catName: "my cat"})