From c1cd9c475c06a7c2c801f77c674e143ec14b9c9c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 11 Sep 2022 08:44:14 +0200 Subject: [PATCH 1/3] Print all missing labels in error message for records, not just one. --- CHANGELOG.md | 4 ++++ jscomp/ml/typecore.ml | 18 ++++++++--------- jscomp/ml/typecore.mli | 2 +- lib/4.06.1/unstable/js_compiler.ml | 20 +++++++++---------- lib/4.06.1/unstable/js_playground_compiler.ml | 20 +++++++++---------- lib/4.06.1/whole_compiler.ml | 20 +++++++++---------- 6 files changed, 44 insertions(+), 40 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3774e32b2c..891260ff3a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,10 @@ - Fix issue where the printer would omit attributes for `->` and `|>` https://github.com/rescript-lang/syntax/pull/629 - Fix printing of optional fields in records https://github.com/rescript-lang/rescript-compiler/issues/5654 +#### :nail_care: Polish + +- Print all missing labels in error message for records, not just one. + # 10.1.0-alpha.1 #### :boom: Breaking Change diff --git a/jscomp/ml/typecore.ml b/jscomp/ml/typecore.ml index c0e36b5bd3..e12af2e6bc 100644 --- a/jscomp/ml/typecore.ml +++ b/jscomp/ml/typecore.ml @@ -35,7 +35,7 @@ type error = | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string - | Label_missing of string list + | Labels_missing of string list | Label_not_mutable of Longident.t | Wrong_name of string * type_expr * string * Path.t * string * string list | Name_type_mismatch of @@ -2167,7 +2167,8 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = unify_exp_types loc env ty_record (instance env ty_expected); check_duplicates loc env lbl_exp_list; let (_, { lbl_all = label_descriptions; lbl_repres = representation}, _) = List.hd lbl_exp_list in - let label_definitions = + let labels_missing = ref [] in + let label_definitions = let matching_label lbl = List.find (fun (_, lbl',_) -> lbl'.lbl_pos = lbl.lbl_pos) @@ -2179,13 +2180,12 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = | (lid, _lbl, lbl_exp) -> Overridden (lid, lbl_exp) | exception Not_found -> - if label_is_optional lbl then - Overridden ({loc ; txt = Lident lbl.lbl_name}, - option_none lbl.lbl_arg loc) - else - raise(Error(loc, env, Label_missing [lbl.lbl_name]))) + if not (label_is_optional lbl) then labels_missing := lbl.lbl_name :: !labels_missing; + Overridden ({loc ; txt = Lident lbl.lbl_name}, option_none lbl.lbl_arg loc)) label_descriptions in + if !labels_missing <> [] then + raise(Error(loc, env, Labels_missing (List.rev !labels_missing))); let fields = Array.map2 (fun descr def -> descr, def) label_descriptions label_definitions @@ -3643,10 +3643,10 @@ let report_error env ppf = function type_expr ty print_label l | Label_multiply_defined s -> fprintf ppf "The record field label %s is defined several times" s - | Label_missing labels -> + | Labels_missing labels -> let print_labels ppf = List.iter (fun lbl -> fprintf ppf "@ %s" ( lbl)) in - fprintf ppf "@[Some record fields are undefined:%a@]" + fprintf ppf "@[Some required record fields are missing:%a@]" print_labels labels | Label_not_mutable lid -> fprintf ppf "The record field %a is not mutable" longident lid diff --git a/jscomp/ml/typecore.mli b/jscomp/ml/typecore.mli index 742818fbdd..5eb4d3a973 100644 --- a/jscomp/ml/typecore.mli +++ b/jscomp/ml/typecore.mli @@ -72,7 +72,7 @@ type error = | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string - | Label_missing of string list + | Labels_missing of string list | Label_not_mutable of Longident.t | Wrong_name of string * type_expr * string * Path.t * string * string list | Name_type_mismatch of diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 35bfc59e44..aa51efe07f 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -38879,7 +38879,7 @@ type error = | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string - | Label_missing of string list + | Labels_missing of string list | Label_not_mutable of Longident.t | Wrong_name of string * type_expr * string * Path.t * string * string list | Name_type_mismatch of @@ -38984,7 +38984,7 @@ type error = | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string - | Label_missing of string list + | Labels_missing of string list | Label_not_mutable of Longident.t | Wrong_name of string * type_expr * string * Path.t * string * string list | Name_type_mismatch of @@ -41116,7 +41116,8 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = unify_exp_types loc env ty_record (instance env ty_expected); check_duplicates loc env lbl_exp_list; let (_, { lbl_all = label_descriptions; lbl_repres = representation}, _) = List.hd lbl_exp_list in - let label_definitions = + let labels_missing = ref [] in + let label_definitions = let matching_label lbl = List.find (fun (_, lbl',_) -> lbl'.lbl_pos = lbl.lbl_pos) @@ -41128,13 +41129,12 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = | (lid, _lbl, lbl_exp) -> Overridden (lid, lbl_exp) | exception Not_found -> - if label_is_optional lbl then - Overridden ({loc ; txt = Lident lbl.lbl_name}, - option_none lbl.lbl_arg loc) - else - raise(Error(loc, env, Label_missing [lbl.lbl_name]))) + if not (label_is_optional lbl) then labels_missing := lbl.lbl_name :: !labels_missing; + Overridden ({loc ; txt = Lident lbl.lbl_name}, option_none lbl.lbl_arg loc)) label_descriptions in + if !labels_missing <> [] then + raise(Error(loc, env, Labels_missing (List.rev !labels_missing))); let fields = Array.map2 (fun descr def -> descr, def) label_descriptions label_definitions @@ -42592,10 +42592,10 @@ let report_error env ppf = function type_expr ty print_label l | Label_multiply_defined s -> fprintf ppf "The record field label %s is defined several times" s - | Label_missing labels -> + | Labels_missing labels -> let print_labels ppf = List.iter (fun lbl -> fprintf ppf "@ %s" ( lbl)) in - fprintf ppf "@[Some record fields are undefined:%a@]" + fprintf ppf "@[Some required record fields are missing:%a@]" print_labels labels | Label_not_mutable lid -> fprintf ppf "The record field %a is not mutable" longident lid diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index fc16855cac..9557e9de08 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -38879,7 +38879,7 @@ type error = | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string - | Label_missing of string list + | Labels_missing of string list | Label_not_mutable of Longident.t | Wrong_name of string * type_expr * string * Path.t * string * string list | Name_type_mismatch of @@ -38984,7 +38984,7 @@ type error = | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string - | Label_missing of string list + | Labels_missing of string list | Label_not_mutable of Longident.t | Wrong_name of string * type_expr * string * Path.t * string * string list | Name_type_mismatch of @@ -41116,7 +41116,8 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = unify_exp_types loc env ty_record (instance env ty_expected); check_duplicates loc env lbl_exp_list; let (_, { lbl_all = label_descriptions; lbl_repres = representation}, _) = List.hd lbl_exp_list in - let label_definitions = + let labels_missing = ref [] in + let label_definitions = let matching_label lbl = List.find (fun (_, lbl',_) -> lbl'.lbl_pos = lbl.lbl_pos) @@ -41128,13 +41129,12 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = | (lid, _lbl, lbl_exp) -> Overridden (lid, lbl_exp) | exception Not_found -> - if label_is_optional lbl then - Overridden ({loc ; txt = Lident lbl.lbl_name}, - option_none lbl.lbl_arg loc) - else - raise(Error(loc, env, Label_missing [lbl.lbl_name]))) + if not (label_is_optional lbl) then labels_missing := lbl.lbl_name :: !labels_missing; + Overridden ({loc ; txt = Lident lbl.lbl_name}, option_none lbl.lbl_arg loc)) label_descriptions in + if !labels_missing <> [] then + raise(Error(loc, env, Labels_missing (List.rev !labels_missing))); let fields = Array.map2 (fun descr def -> descr, def) label_descriptions label_definitions @@ -42592,10 +42592,10 @@ let report_error env ppf = function type_expr ty print_label l | Label_multiply_defined s -> fprintf ppf "The record field label %s is defined several times" s - | Label_missing labels -> + | Labels_missing labels -> let print_labels ppf = List.iter (fun lbl -> fprintf ppf "@ %s" ( lbl)) in - fprintf ppf "@[Some record fields are undefined:%a@]" + fprintf ppf "@[Some required record fields are missing:%a@]" print_labels labels | Label_not_mutable lid -> fprintf ppf "The record field %a is not mutable" longident lid diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index ba1bdc149a..51e5605c2e 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -215266,7 +215266,7 @@ type error = | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string - | Label_missing of string list + | Labels_missing of string list | Label_not_mutable of Longident.t | Wrong_name of string * type_expr * string * Path.t * string * string list | Name_type_mismatch of @@ -215371,7 +215371,7 @@ type error = | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string - | Label_missing of string list + | Labels_missing of string list | Label_not_mutable of Longident.t | Wrong_name of string * type_expr * string * Path.t * string * string list | Name_type_mismatch of @@ -217503,7 +217503,8 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = unify_exp_types loc env ty_record (instance env ty_expected); check_duplicates loc env lbl_exp_list; let (_, { lbl_all = label_descriptions; lbl_repres = representation}, _) = List.hd lbl_exp_list in - let label_definitions = + let labels_missing = ref [] in + let label_definitions = let matching_label lbl = List.find (fun (_, lbl',_) -> lbl'.lbl_pos = lbl.lbl_pos) @@ -217515,13 +217516,12 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected = | (lid, _lbl, lbl_exp) -> Overridden (lid, lbl_exp) | exception Not_found -> - if label_is_optional lbl then - Overridden ({loc ; txt = Lident lbl.lbl_name}, - option_none lbl.lbl_arg loc) - else - raise(Error(loc, env, Label_missing [lbl.lbl_name]))) + if not (label_is_optional lbl) then labels_missing := lbl.lbl_name :: !labels_missing; + Overridden ({loc ; txt = Lident lbl.lbl_name}, option_none lbl.lbl_arg loc)) label_descriptions in + if !labels_missing <> [] then + raise(Error(loc, env, Labels_missing (List.rev !labels_missing))); let fields = Array.map2 (fun descr def -> descr, def) label_descriptions label_definitions @@ -218979,10 +218979,10 @@ let report_error env ppf = function type_expr ty print_label l | Label_multiply_defined s -> fprintf ppf "The record field label %s is defined several times" s - | Label_missing labels -> + | Labels_missing labels -> let print_labels ppf = List.iter (fun lbl -> fprintf ppf "@ %s" ( lbl)) in - fprintf ppf "@[Some record fields are undefined:%a@]" + fprintf ppf "@[Some required record fields are missing:%a@]" print_labels labels | Label_not_mutable lid -> fprintf ppf "The record field %a is not mutable" longident lid From 1bdd454fee1bad37fe18fa180d6a1993a46abd9a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 11 Sep 2022 08:44:46 +0200 Subject: [PATCH 2/3] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 891260ff3a..5b373bd9e4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,7 +20,7 @@ #### :nail_care: Polish -- Print all missing labels in error message for records, not just one. +- Print all missing labels in error message for records, not just one https://github.com/rescript-lang/rescript-compiler/pull/5657 # 10.1.0-alpha.1 From b190848263d324ef1cf8fa06fef384095a65957c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 11 Sep 2022 08:45:35 +0200 Subject: [PATCH 3/3] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5b373bd9e4..7212e0f68b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,7 +20,7 @@ #### :nail_care: Polish -- Print all missing labels in error message for records, not just one https://github.com/rescript-lang/rescript-compiler/pull/5657 +- Mention all missing fields in error message for records, not just one https://github.com/rescript-lang/rescript-compiler/pull/5657 # 10.1.0-alpha.1