@@ -27,7 +27,7 @@ type native_repr_kind = Unboxed | Untagged
27
27
type error =
28
28
Repeated_parameter
29
29
| Duplicate_constructor of string
30
- | Duplicate_label of string
30
+ | Duplicate_label of string * string option
31
31
| Recursive_abbrev of string
32
32
| Cycle_in_def of string * type_expr
33
33
| Definition_mismatch of type_expr * Includecore .type_mismatch list
@@ -207,17 +207,17 @@ let make_params env params =
207
207
in
208
208
List. map make_param params
209
209
210
- let transl_labels env closed lbls =
210
+ let transl_labels ? recordName env closed lbls =
211
211
if ! Config. bs_only then
212
212
match ! Builtin_attributes. check_duplicated_labels lbls with
213
213
| None -> ()
214
- | Some {loc;txt =name } -> raise (Error (loc,Duplicate_label name))
214
+ | Some {loc;txt =name } -> raise (Error (loc,Duplicate_label ( name, recordName) ))
215
215
else (
216
216
let all_labels = ref StringSet. empty in
217
217
List. iter
218
218
(fun {pld_name = {txt =name ; loc} } ->
219
219
if StringSet. mem name ! all_labels then
220
- raise(Error (loc, Duplicate_label name));
220
+ raise(Error (loc, Duplicate_label ( name, recordName) ));
221
221
all_labels := StringSet. add name ! all_labels)
222
222
lbls);
223
223
let mk {pld_name =name ;pld_mutable =mut ;pld_type =arg ;pld_loc =loc ;
@@ -501,7 +501,7 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
501
501
{typ with ptyp_desc = Ptyp_constr ({txt = Lident " option" ; loc= typ.ptyp_loc}, [typ])}
502
502
else typ in
503
503
{lbl with pld_type = typ }) in
504
- let lbls, lbls' = transl_labels env true lbls in
504
+ let lbls, lbls' = transl_labels ~record Name:(sdecl.ptype_name.txt) env true lbls in
505
505
let lbls_opt = match Record_type_spread. has_type_spread lbls with
506
506
| true ->
507
507
let rec extract t = match t.desc with
@@ -545,7 +545,7 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
545
545
| [] -> ()
546
546
| lbl ::rest ->
547
547
let name = lbl.ld_id.name in
548
- if StringSet. mem name seen then raise(Error (loc, Duplicate_label name));
548
+ if StringSet. mem name seen then raise(Error (loc, Duplicate_label ( name, Some sdecl.ptype_name.txt) ));
549
549
check_duplicates loc rest (StringSet. add name seen) in
550
550
(match lbls_opt with
551
551
| Some (lbls , lbls' ) ->
@@ -1998,8 +1998,10 @@ let report_error ppf = function
1998
1998
fprintf ppf " A type parameter occurs several times"
1999
1999
| Duplicate_constructor s ->
2000
2000
fprintf ppf " Two constructors are named %s" s
2001
- | Duplicate_label s ->
2002
- fprintf ppf " Two labels are named %s" s
2001
+ | Duplicate_label (s , None) ->
2002
+ fprintf ppf " The field @{<info>%s@} is defined several times in this record. Fields can only be added once to a record." s
2003
+ | Duplicate_label (s , Some recordName ) ->
2004
+ fprintf ppf " The field @{<info>%s@} is defined several times in the record @{<info>%s@}. Fields can only be added once to a record." s recordName
2003
2005
| Recursive_abbrev s ->
2004
2006
fprintf ppf " The type abbreviation %s is cyclic" s
2005
2007
| Cycle_in_def (s , ty ) ->
0 commit comments