From 6772661442dfa9562d77855f64bb2efdd08a5fb4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Wed, 10 Sep 2025 11:24:37 +0200 Subject: [PATCH 01/11] Make it a compile error to have inline record fields whose fields conflict with the variant tag --- compiler/ml/ast_untagged_variants.ml | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 0a8de20d52..0f2f368bd9 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 exception Error of Location.t * error let report_error ppf = @@ -90,6 +91,11 @@ let report_error ppf = | DuplicateLiteral s -> "Duplicate literal " ^ s ^ "." | ConstructorMoreThanOneArg name -> "Constructor " ^ name ^ " has more than one argument.") + | TagFieldNameConflict (constructor_name, field_name) -> + fprintf ppf + "Constructor %s: the @tag name \"%s\" conflicts with inline record field \"%s\". \ + Use a different @tag name or rename the field." + constructor_name field_name field_name (* Type of the runtime representation of an untagged block (case with payoad) *) type block_type = @@ -462,12 +468,27 @@ 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) -> + match process_tag_name cstr.cd_attributes with + | Some tag_name -> ( + match cstr.cd_args with + | Cstr_record fields -> + List.iter (fun (field : Types.label_declaration) -> + if Ident.name field.ld_id = tag_name then + raise (Error (cstr.cd_loc, TagFieldNameConflict (Ident.name cstr.cd_id, tag_name))) + ) fields + | _ -> ()) + | None -> () + ) 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 From f65bc014c69bbea4094ee41891fbb00702f4d5dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Wed, 10 Sep 2025 11:28:05 +0200 Subject: [PATCH 02/11] Handle @as attribute --- compiler/ml/ast_untagged_variants.ml | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 0f2f368bd9..5fe21433a3 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -323,6 +323,19 @@ let process_tag_name (attrs : Parsetree.attributes) = | _ -> ()); !st +let process_as_name (attrs : Parsetree.attributes) = + let st = ref None in + Ext_list.iter attrs (fun ({txt; loc}, payload) -> + match txt with + | "as" -> + if !st = None then ( + (match Ast_payload.is_single_string payload with + | None -> () + | Some (s, _dec) -> st := Some s)) + else raise (Error (loc, Duplicated_bs_as)) + | _ -> ()); + !st + let get_tag_name (cstr : Types.constructor_declaration) = process_tag_name cstr.cd_attributes @@ -475,8 +488,15 @@ let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) = match cstr.cd_args with | Cstr_record fields -> List.iter (fun (field : Types.label_declaration) -> - if Ident.name field.ld_id = tag_name then + (* Check if field name conflicts with tag *) + let field_name = Ident.name field.ld_id in + if field_name = tag_name then + raise (Error (cstr.cd_loc, TagFieldNameConflict (Ident.name cstr.cd_id, tag_name))); + (* Check if @as name conflicts with tag *) + match process_as_name field.ld_attributes with + | Some as_name when as_name = tag_name -> raise (Error (cstr.cd_loc, TagFieldNameConflict (Ident.name cstr.cd_id, tag_name))) + | _ -> () ) fields | _ -> ()) | None -> () From 887fc6fa61ae2ed2ef406c34dcd55c477d0bb29b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Thu, 11 Sep 2025 10:53:12 +0200 Subject: [PATCH 03/11] Format code --- compiler/ml/ast_untagged_variants.ml | 38 +++++++++++++++++----------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 5fe21433a3..6ed2b1e48a 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -93,8 +93,8 @@ let report_error ppf = "Constructor " ^ name ^ " has more than one argument.") | TagFieldNameConflict (constructor_name, field_name) -> fprintf ppf - "Constructor %s: the @tag name \"%s\" conflicts with inline record field \"%s\". \ - Use a different @tag name or rename the field." + "Constructor %s: the @tag name \"%s\" conflicts with inline record field \ + \"%s\". Use a different @tag name or rename the field." constructor_name field_name field_name (* Type of the runtime representation of an untagged block (case with payoad) *) @@ -328,10 +328,10 @@ let process_as_name (attrs : Parsetree.attributes) = Ext_list.iter attrs (fun ({txt; loc}, payload) -> match txt with | "as" -> - if !st = None then ( - (match Ast_payload.is_single_string payload with + if !st = None then + match Ast_payload.is_single_string payload with | None -> () - | Some (s, _dec) -> st := Some s)) + | Some (s, _dec) -> st := Some s else raise (Error (loc, Duplicated_bs_as)) | _ -> ()); !st @@ -482,25 +482,33 @@ let names_from_type_variant ?(is_untagged_def = false) ~env Some {consts; blocks} let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) = - List.iter (fun (cstr : Types.constructor_declaration) -> - match process_tag_name cstr.cd_attributes with - | Some tag_name -> ( + List.iter + (fun (cstr : Types.constructor_declaration) -> + match process_tag_name cstr.cd_attributes with + | Some tag_name -> ( match cstr.cd_args with | Cstr_record fields -> - List.iter (fun (field : Types.label_declaration) -> + List.iter + (fun (field : Types.label_declaration) -> (* Check if field name conflicts with tag *) let field_name = Ident.name field.ld_id in if field_name = tag_name then - raise (Error (cstr.cd_loc, TagFieldNameConflict (Ident.name cstr.cd_id, tag_name))); + raise + (Error + ( cstr.cd_loc, + TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) )); (* Check if @as name conflicts with tag *) match process_as_name field.ld_attributes with | Some as_name when as_name = tag_name -> - raise (Error (cstr.cd_loc, TagFieldNameConflict (Ident.name cstr.cd_id, tag_name))) - | _ -> () - ) fields + raise + (Error + ( cstr.cd_loc, + TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) )) + | _ -> ()) + fields | _ -> ()) - | None -> () - ) cstrs + | None -> ()) + cstrs type well_formedness_check = { is_untagged_def: bool; From 5bba7f8c4985a8f734a0e8bfe82b108dad0bfb82 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Thu, 11 Sep 2025 10:55:36 +0200 Subject: [PATCH 04/11] Add super error fixtures --- .../variant_tag_overlaps_with_field.res.expected | 10 ++++++++++ .../variant_tag_overlaps_with_field_as.res.expected | 10 ++++++++++ .../fixtures/variant_tag_overlaps_with_field.res | 4 ++++ .../fixtures/variant_tag_overlaps_with_field_as.res | 4 ++++ 4 files changed, 28 insertions(+) create mode 100644 tests/build_tests/super_errors/expected/variant_tag_overlaps_with_field.res.expected create mode 100644 tests/build_tests/super_errors/expected/variant_tag_overlaps_with_field_as.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/variant_tag_overlaps_with_field.res create mode 100644 tests/build_tests/super_errors/fixtures/variant_tag_overlaps_with_field_as.res 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..4bb1957441 --- /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 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..903426e46f --- /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 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/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"}) From 465a30f547890291e34265dcd5ee18cb2022cbaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Thu, 11 Sep 2025 11:04:38 +0200 Subject: [PATCH 05/11] Check variants without a @tag decorator --- compiler/ml/ast_untagged_variants.ml | 51 ++++++++++--------- ...uplicate_as_tag_inline_record.res.expected | 8 +++ .../duplicate_as_tag_inline_record.res | 1 + 3 files changed, 36 insertions(+), 24 deletions(-) create mode 100644 tests/build_tests/super_errors/expected/duplicate_as_tag_inline_record.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/duplicate_as_tag_inline_record.res diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 6ed2b1e48a..4bd0897baf 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -484,30 +484,33 @@ let names_from_type_variant ?(is_untagged_def = false) ~env let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) = List.iter (fun (cstr : Types.constructor_declaration) -> - match process_tag_name cstr.cd_attributes with - | Some tag_name -> ( - match cstr.cd_args with - | Cstr_record fields -> - List.iter - (fun (field : Types.label_declaration) -> - (* Check if field name conflicts with tag *) - let field_name = Ident.name field.ld_id in - if field_name = tag_name then - raise - (Error - ( cstr.cd_loc, - TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) )); - (* Check if @as name conflicts with tag *) - match process_as_name field.ld_attributes with - | Some as_name when as_name = tag_name -> - raise - (Error - ( cstr.cd_loc, - TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) )) - | _ -> ()) - fields - | _ -> ()) - | None -> ()) + (* Get the effective tag name - either explicit @tag or constructor name *) + let tag_name = + match process_tag_name cstr.cd_attributes with + | Some explicit_tag -> explicit_tag + | None -> Ident.name cstr.cd_id (* Default to constructor name *) + in + match cstr.cd_args with + | Cstr_record fields -> + List.iter + (fun (field : Types.label_declaration) -> + (* Check if field name conflicts with tag *) + let field_name = Ident.name field.ld_id in + if field_name = tag_name then + raise + (Error + ( cstr.cd_loc, + TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) )); + (* Check if @as name conflicts with tag *) + match process_as_name field.ld_attributes with + | Some as_name when as_name = tag_name -> + raise + (Error + ( cstr.cd_loc, + TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) )) + | _ -> ()) + fields + | _ -> ()) cstrs type well_formedness_check = { 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/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}) From ae257621250dabcf781c3ae578c1adf752ee0199 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Thu, 11 Sep 2025 11:18:04 +0200 Subject: [PATCH 06/11] Use effective field name instead of checking actual field name and @as separately --- compiler/ml/ast_untagged_variants.ml | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 4bd0897baf..db0be83138 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -494,21 +494,17 @@ let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) = | Cstr_record fields -> List.iter (fun (field : Types.label_declaration) -> - (* Check if field name conflicts with tag *) - let field_name = Ident.name field.ld_id in - if field_name = tag_name then - raise - (Error - ( cstr.cd_loc, - TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) )); - (* Check if @as name conflicts with tag *) - match process_as_name field.ld_attributes with - | Some as_name when as_name = tag_name -> + (* Get the effective field name in JavaScript output *) + let effective_field_name = match process_as_name field.ld_attributes with + | Some as_name -> as_name (* Use @as name if present *) + | None -> Ident.name field.ld_id (* Otherwise use field name *) + in + (* Check if effective field name conflicts with tag *) + if effective_field_name = tag_name then raise (Error ( cstr.cd_loc, - TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) )) - | _ -> ()) + TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) ))) fields | _ -> ()) cstrs From c293649a1ccd61ce767184e5f15aeee20d5a0f43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Thu, 11 Sep 2025 11:19:51 +0200 Subject: [PATCH 07/11] Format OCaml --- compiler/ml/ast_untagged_variants.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index db0be83138..1ee6e65036 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -495,9 +495,10 @@ let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) = List.iter (fun (field : Types.label_declaration) -> (* Get the effective field name in JavaScript output *) - let effective_field_name = match process_as_name field.ld_attributes with - | Some as_name -> as_name (* Use @as name if present *) - | None -> Ident.name field.ld_id (* Otherwise use field name *) + let effective_field_name = + match process_as_name field.ld_attributes with + | Some as_name -> as_name (* Use @as name if present *) + | None -> Ident.name field.ld_id (* Otherwise use field name *) in (* Check if effective field name conflicts with tag *) if effective_field_name = tag_name then From 5e98a1221b6c02c1544800ed0b47009d4806fb3a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Thu, 11 Sep 2025 11:23:50 +0200 Subject: [PATCH 08/11] Add CHANGELOG entry --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0a69f1052b..1b0971cf8e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,7 @@ - Add `reset` to `experimental_features` to correctly reset playground. https://github.com/rescript-lang/rescript/pull/7868 - Fix crash with `@get` on external of type `unit => 'a`. https://github.com/rescript-lang/rescript/pull/7866 - Fix record type spreads in inline records. https://github.com/rescript-lang/rescript/pull/7859 +- Make inline record fields that overlap with a variant's tag a compile error. https://github.com/rescript-lang/rescript/pull/7875 #### :memo: Documentation From 5c5f2bd3e788c113510d2755eca2aa7695bea69a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Fri, 26 Sep 2025 12:33:41 +0200 Subject: [PATCH 09/11] Reuse process_tag_type instead of duplicating logic in process_as_name --- compiler/ml/ast_untagged_variants.ml | 19 +++---------------- 1 file changed, 3 insertions(+), 16 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 1ee6e65036..ab4d40abae 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -323,19 +323,6 @@ let process_tag_name (attrs : Parsetree.attributes) = | _ -> ()); !st -let process_as_name (attrs : Parsetree.attributes) = - let st = ref None in - Ext_list.iter attrs (fun ({txt; loc}, payload) -> - match txt with - | "as" -> - if !st = None then - match Ast_payload.is_single_string payload with - | None -> () - | Some (s, _dec) -> st := Some s - else raise (Error (loc, Duplicated_bs_as)) - | _ -> ()); - !st - let get_tag_name (cstr : Types.constructor_declaration) = process_tag_name cstr.cd_attributes @@ -496,9 +483,9 @@ let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) = (fun (field : Types.label_declaration) -> (* Get the effective field name in JavaScript output *) let effective_field_name = - match process_as_name field.ld_attributes with - | Some as_name -> as_name (* Use @as name if present *) - | None -> Ident.name field.ld_id (* Otherwise use field name *) + match process_tag_type field.ld_attributes with + | Some (String as_name) -> as_name (* Use @as name if present *) + | _ -> Ident.name field.ld_id (* Otherwise use field name *) in (* Check if effective field name conflicts with tag *) if effective_field_name = tag_name then From 40d5e14d0eeeaf8f0fa7697c35a8e211d9d93d4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Fri, 26 Sep 2025 12:50:12 +0200 Subject: [PATCH 10/11] Clarify tag/as conflict error message by using field name from type instead of only showing runtime name --- compiler/ml/ast_untagged_variants.ml | 29 ++++++++++--------- ...riant_tag_overlaps_with_field.res.expected | 2 +- ...nt_tag_overlaps_with_field_as.res.expected | 2 +- 3 files changed, 18 insertions(+), 15 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index ab4d40abae..9fc3423fd2 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -57,7 +57,7 @@ type error = | Duplicated_bs_as | InvalidVariantTagAnnotation | InvalidUntaggedVariantDefinition of untagged_error - | TagFieldNameConflict of string * string + | TagFieldNameConflict of string * string * string exception Error of Location.t * error let report_error ppf = @@ -91,11 +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) -> + | TagFieldNameConflict (constructor_name, field_name, runtime_value) -> fprintf ppf - "Constructor %s: the @tag name \"%s\" conflicts with inline record field \ - \"%s\". Use a different @tag name or rename the field." - constructor_name field_name field_name + "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 = @@ -471,28 +472,30 @@ let names_from_type_variant ?(is_untagged_def = false) ~env let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) = List.iter (fun (cstr : Types.constructor_declaration) -> - (* Get the effective tag name - either explicit @tag or constructor name *) - let tag_name = + 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 -> Ident.name cstr.cd_id (* Default to constructor name *) + | None -> constructor_name in match cstr.cd_args with | Cstr_record fields -> List.iter (fun (field : Types.label_declaration) -> - (* Get the effective field name in JavaScript output *) + 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 (* Use @as name if present *) - | _ -> Ident.name field.ld_id (* Otherwise use field name *) + | 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 = tag_name then + if effective_field_name = effective_tag_name then raise (Error ( cstr.cd_loc, - TagFieldNameConflict (Ident.name cstr.cd_id, tag_name) ))) + TagFieldNameConflict + (constructor_name, field_name, effective_field_name) ))) fields | _ -> ()) cstrs 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 index 4bb1957441..8da3e27975 100644 --- 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 @@ -7,4 +7,4 @@ 3 │ 4 │ let cat = Cat({name: "my cat"}) - Constructor Cat: the @tag name "name" conflicts with inline record field "name". Use a different @tag name or rename the field. \ No newline at end of file + 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 index 903426e46f..e29271ac07 100644 --- 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 @@ -7,4 +7,4 @@ 3 │ 4 │ let cat = Cat({catName: "my cat"}) - Constructor Cat: the @tag name "name" conflicts with inline record field "name". Use a different @tag name or rename the field. \ No newline at end of file + 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 From 08afd62c92162a7da1dc863c419a01ed37d96fc4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Fri, 26 Sep 2025 13:39:34 +0200 Subject: [PATCH 11/11] Quote constructor name --- compiler/ml/ast_untagged_variants.ml | 6 +++--- .../expected/variant_tag_overlaps_with_field.res.expected | 2 +- .../variant_tag_overlaps_with_field_as.res.expected | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 9fc3423fd2..9cb7d015c8 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -93,9 +93,9 @@ let report_error ppf = "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 \"%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) *) 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 index 8da3e27975..5add1b8454 100644 --- 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 @@ -7,4 +7,4 @@ 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 + 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 index e29271ac07..5ad9cf2622 100644 --- 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 @@ -7,4 +7,4 @@ 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 + 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