Skip to content

Commit

Permalink
[message reporting] Update sub errors handling (#11595)
Browse files Browse the repository at this point in the history
* deal with some sub error TODO

* Add misc test for 'Called from macro here' sub error

* Handle more sub error TODO

* usual List.rev List.rev x

* More TODOs

* Handle more sub errors

* Update tests

* Last (?) sub error TODO

* [tests] Update expected result with sub error
  • Loading branch information
kLabz authored Mar 12, 2024
1 parent 52888e2 commit 603f6f6
Show file tree
Hide file tree
Showing 33 changed files with 188 additions and 110 deletions.
4 changes: 2 additions & 2 deletions src/compiler/compiler.ml
Original file line number Diff line number Diff line change
Expand Up @@ -430,8 +430,8 @@ with
ctx.has_error <- false;
ctx.messages <- [];
end else begin
error ctx (Printf.sprintf "You cannot access the %s package while %s (for %s)" pack (if pf = "macro" then "in a macro" else "targeting " ^ pf) (s_type_path m) ) p;
List.iter (error ~depth:1 ctx (Error.compl_msg "referenced here")) (List.rev pl);
let sub = List.map (fun p -> Error.make_error ~depth:1 (Error.Custom (Error.compl_msg "referenced here")) p) pl in
error_ext ctx (Error.make_error (Error.Custom (Printf.sprintf "You cannot access the %s package while %s (for %s)" pack (if pf = "macro" then "in a macro" else "targeting " ^ pf) (s_type_path m))) ~sub p)
end
| Error.Error err ->
error_ext ctx err
Expand Down
6 changes: 3 additions & 3 deletions src/filters/localStatic.ml
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
open Common
open Type
open Typecore
open Error
Expand All @@ -14,8 +13,9 @@ let promote_local_static lsctx run v eo =
let c = lsctx.ctx.c.curclass in
begin try
let cf = PMap.find name c.cl_statics in
display_error lsctx.ctx.com (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name) v.v_pos;
raise_typing_error ~depth:1 "Conflicting field was found here" cf.cf_name_pos;
raise_typing_error_ext (make_error (Custom (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name)) ~sub:[
make_error ~depth:1 (Custom "Conflicting field was found here") cf.cf_name_pos
] v.v_pos);
with Not_found ->
let cf = mk_field name ~static:true v.v_type v.v_pos v.v_pos in
cf.cf_meta <- v.v_meta;
Expand Down
5 changes: 3 additions & 2 deletions src/optimization/analyzerTexpr.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1250,8 +1250,9 @@ module Purity = struct
begin try
apply_to_class com c
with Purity_conflict(impure,p) ->
com.error "Impure field overrides/implements field which was explicitly marked as @:pure" impure.pn_field.cf_pos;
Error.raise_typing_error ~depth:1 (Error.compl_msg "Pure field is here") p;
Error.raise_typing_error_ext (Error.make_error (Custom "Impure field overrides/implements field which was explicitly marked as @:pure") ~sub:[
Error.make_error ~depth:1 (Custom (Error.compl_msg "Pure field is here")) p
] impure.pn_field.cf_pos)
end
| _ -> ()
) com.types;
Expand Down
6 changes: 3 additions & 3 deletions src/optimization/inlineConstructors.ml
Original file line number Diff line number Diff line change
Expand Up @@ -131,9 +131,9 @@ let inline_constructors ctx original_e =
| IOKCtor(ioc) ->
List.iter (fun v -> if v.v_id < 0 then cancel_v v p) io.io_dependent_vars;
if ioc.ioc_forced then begin
(* TODO construct error with sub *)
display_error ctx.com "Forced inline constructor could not be inlined" io.io_pos;
display_error ~depth:1 ctx.com (compl_msg "Cancellation happened here") p;
display_error_ext ctx.com (make_error (Custom "Forced inline constructor could not be inlined") ~sub:([
(make_error ~depth:1 (Custom (compl_msg "Cancellation happened here")) p)
]) io.io_pos);
end
| _ -> ()
end
Expand Down
22 changes: 10 additions & 12 deletions src/typing/callUnification.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ let unify_call_args ctx el args r callp inline force_inline in_overload =
let msg = ("For " ^ (if opt then "optional " else "") ^ "function argument '" ^ name ^ "'") in
let e = match e.err_message with
| Unify l -> { e with err_message = Unify (l @ [(Unify_custom msg)])}
| Custom parent -> { e with err_message = Custom (parent ^ "\n" ^ msg)}
| _ -> { e with err_sub = (make_error (Custom (compl_msg msg)) e.err_pos) :: e.err_sub }
in
raise_error { e with err_message = (Call_error (Could_not_unify e.err_message)) }
Expand Down Expand Up @@ -415,9 +414,8 @@ let unify_field_call ctx fa el_typed el p inline =
p
) :: acc
) [] failures in

display_error_ext ctx.com (make_error ~sub (Custom "Could not find a suitable overload, reasons follow") p);
raise_typing_error_ext (make_error ~depth:1 (Custom "End of overload failure reasons") p)
let sub = (make_error ~depth:1 (Custom "End of overload failure reasons") p) :: sub in
raise_typing_error_ext (make_error ~sub (Custom "Could not find a suitable overload, reasons follow") p)
| Some err ->
raise_typing_error_ext err
end
Expand All @@ -429,12 +427,11 @@ let unify_field_call ctx fa el_typed el p inline =
maybe_check_access fcc.fc_field;
commit_delayed_display fcc
| fcc :: l ->
(* TODO construct error with sub *)
display_error ctx.com "Ambiguous overload, candidates follow" p;
let st = s_type (print_context()) in
List.iter (fun fcc ->
display_error ~depth:1 ctx.com (compl_msg (st fcc.fc_type)) fcc.fc_field.cf_name_pos;
) (fcc :: l);
let sub = List.map (fun fcc ->
make_error ~depth:1 (Custom (compl_msg (st fcc.fc_type))) fcc.fc_field.cf_name_pos
) (fcc :: l) in
display_error_ext ctx.com (make_error (Custom "Ambiguous overload, candidates follow") ~sub:(List.rev sub) p);
commit_delayed_display fcc
end else begin match List.rev candidates with
| [] -> fail()
Expand Down Expand Up @@ -513,9 +510,10 @@ object(self)
let ep = err.err_pos in
(* display additional info in the case the error is not part of our original call *)
if ep.pfile <> p.pfile || ep.pmax < p.pmin || ep.pmin > p.pmax then begin
old (if (ep = null_pos) then { err with err_pos = p } else err);
(* TODO add as sub for above error *)
if ep <> null_pos then old (make_error ~depth:(err.err_depth+1) (Custom (compl_msg "Called from macro here")) p);
if ep = null_pos then
old { err with err_pos = p }
else
old { err with err_sub = (make_error ~depth:(err.err_depth+1) (Custom (compl_msg "Called from macro here")) p) :: err.err_sub }
end else
old err;
);
Expand Down
5 changes: 3 additions & 2 deletions src/typing/fields.ml
Original file line number Diff line number Diff line change
Expand Up @@ -221,8 +221,9 @@ let field_access ctx mode f fh e pfield =
if bypass_accessor then (
(match e.eexpr with TLocal _ when Common.defined ctx.com Define.Haxe3Compat -> warning ctx WTemp "Field set has changed here in Haxe 4: call setter explicitly to keep Haxe 3.x behaviour" pfield | _ -> ());
if not (is_physical_field f) then begin
display_error ctx.com "This field cannot be accessed because it is not a real variable" pfield;
display_error ctx.com "Add @:isVar here to enable it" f.cf_pos;
display_error_ext ctx.com (make_error (Custom "This field cannot be accessed because it is not a real variable") ~sub:[
make_error ~depth:1 (Custom "Add @:isVar here to enable it") f.cf_pos
] pfield);
end;
normal false
)
Expand Down
12 changes: 6 additions & 6 deletions src/typing/generic.ml
Original file line number Diff line number Diff line change
Expand Up @@ -355,9 +355,9 @@ let build_generic_class ctx c p tl =
| None ->
begin match cf_old.cf_kind with
| Method _ when not (has_class_flag c CInterface) && not (has_class_flag c CExtern) && not (has_class_field_flag cf_old CfAbstract) ->
(* TODO use sub error *)
display_error ctx.com (Printf.sprintf "Field %s has no expression (possible typing order issue)" cf_new.cf_name) cf_new.cf_pos;
display_error ctx.com (Printf.sprintf "While building %s" (s_type_path cg.cl_path)) p;
display_error_ext ctx.com (make_error (Custom (Printf.sprintf "Field %s has no expression (possible typing order issue)" cf_new.cf_name)) ~sub:([
(make_error ~depth:1 (Custom (compl_msg (Printf.sprintf "While building %s" (s_type_path cg.cl_path)))) p)
]) cf_new.cf_pos);
| _ ->
()
end
Expand Down Expand Up @@ -498,9 +498,9 @@ let type_generic_function ctx fa fcc with_type p =
ignore(follow cf.cf_type);
let rec check e = match e.eexpr with
| TNew({cl_kind = KTypeParameter _} as c,_,_) when not (TypeloadCheck.is_generic_parameter ctx c) ->
(* TODO use sub error *)
display_error ctx.com "Only generic type parameters can be constructed" e.epos;
display_error ctx.com "While specializing this call" p;
display_error_ext ctx.com (make_error (Custom "Only generic type parameters can be constructed") ~sub:([
(make_error ~depth:1 (Custom (compl_msg "While specializing this call")) p)
]) e.epos);
| _ ->
Type.iter check e
in
Expand Down
32 changes: 16 additions & 16 deletions src/typing/typeload.ml
Original file line number Diff line number Diff line change
Expand Up @@ -55,18 +55,18 @@ let check_field_access ctx cff =
try
let _,p2 = List.find (fun (access',_) -> access = access') acc in
if p1 <> null_pos && p2 <> null_pos then begin
(* TODO error with sub *)
display_error ctx.com (Printf.sprintf "Duplicate access modifier %s" (Ast.s_access access)) p1;
display_error ~depth:1 ctx.com (compl_msg "Previously defined here") p2;
display_error_ext ctx.com (make_error (Custom (Printf.sprintf "Duplicate access modifier %s" (Ast.s_access access))) ~sub:([
(make_error ~depth:1 (Custom (compl_msg "Previously defined here")) p2);
]) p1);
end;
loop p1 acc l
with Not_found -> match access with
| APublic | APrivate ->
begin try
let _,p2 = List.find (fun (access',_) -> match access' with APublic | APrivate -> true | _ -> false) acc in
(* TODO error with sub *)
display_error ctx.com (Printf.sprintf "Conflicting access modifier %s" (Ast.s_access access)) p1;
display_error ~depth:1 ctx.com (compl_msg "Conflicts with this") p2;
display_error_ext ctx.com (make_error (Custom (Printf.sprintf "Conflicting access modifier %s" (Ast.s_access access))) ~sub:([
(make_error ~depth:1 (Custom (compl_msg "Conflicts with this")) p2);
]) p1);
loop p1 acc l
with Not_found ->
loop p1 ((access,p1) :: acc) l
Expand Down Expand Up @@ -244,10 +244,10 @@ let is_redefined ctx cf1 fields p =
let cf2 = PMap.find cf1.cf_name fields in
let st = s_type (print_context()) in
if not (type_iseq cf1.cf_type cf2.cf_type) then begin
(* TODO construct error with sub? *)
display_error ctx.com ("Cannot redefine field " ^ cf1.cf_name ^ " with different type") p;
display_error ctx.com ("First type was " ^ (st cf1.cf_type)) cf1.cf_pos;
raise_typing_error ("Second type was " ^ (st cf2.cf_type)) cf2.cf_pos
raise_typing_error_ext (make_error (Custom ("Cannot redefine field " ^ cf1.cf_name ^ " with different type")) ~sub:([
(make_error ~depth:1 (Custom (compl_msg ("Second type was " ^ (st cf2.cf_type)))) cf2.cf_pos);
(make_error ~depth:1 (Custom (compl_msg ("First type was " ^ (st cf1.cf_type)))) cf1.cf_pos);
]) p)
end else
true
with Not_found ->
Expand Down Expand Up @@ -844,9 +844,9 @@ let init_core_api ctx c =
| Invalid_argument _ ->
raise_typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos
| Unify_error l ->
(* TODO send as one call with sub errors *)
display_error ctx.com ("Type parameter " ^ ttp2.ttp_name ^ " has different constraint than in core type") c.cl_pos;
display_error ctx.com (error_msg (Unify l)) c.cl_pos;
display_error_ext ctx.com (make_error (Custom ("Type parameter " ^ ttp2.ttp_name ^ " has different constraint than in core type")) ~sub:([
(make_error ~depth:1 (Custom (compl_msg (error_msg (Unify l)))) c.cl_pos);
]) c.cl_pos);
) ccore.cl_params c.cl_params;
with Invalid_argument _ ->
raise_typing_error "Class must have the same number of type parameters as core type" c.cl_pos
Expand All @@ -859,9 +859,9 @@ let init_core_api ctx c =
(try
type_eq EqCoreType (apply_params ccore.cl_params (extract_param_types c.cl_params) f.cf_type) f2.cf_type
with Unify_error l ->
(* TODO send as one call with sub errors *)
display_error ctx.com ("Field " ^ f.cf_name ^ " has different type than in core type") p;
display_error ctx.com (error_msg (Unify l)) p);
display_error_ext ctx.com (make_error (Custom ("Field " ^ f.cf_name ^ " has different type than in core type")) ~sub:([
(make_error ~depth:1 (Custom (compl_msg (error_msg (Unify l)))) p);
]) p));
if (has_class_field_flag f2 CfPublic) <> (has_class_field_flag f CfPublic) then raise_typing_error ("Field " ^ f.cf_name ^ " has different visibility than core type") p;
(match f2.cf_doc with
| None -> f2.cf_doc <- f.cf_doc
Expand Down
50 changes: 26 additions & 24 deletions src/typing/typeloadCheck.ml
Original file line number Diff line number Diff line change
Expand Up @@ -132,9 +132,9 @@ let copy_meta meta_src meta_target sl =

let check_native_name_override ctx child base =
let error base_pos child_pos =
(* TODO construct error *)
display_error ctx.com ("Field " ^ child.cf_name ^ " has different @:native value than in superclass") child_pos;
display_error ~depth:1 ctx.com (compl_msg "Base field is defined here") base_pos
display_error_ext ctx.com (make_error (Custom ("Field " ^ child.cf_name ^ " has different @:native value than in superclass")) ~sub:([
(make_error ~depth:1 (Custom (compl_msg "Base field is defined here")) base_pos)
]) child_pos);
in
try
let child_name, child_pos = Naming.get_native_name child.cf_meta in
Expand Down Expand Up @@ -189,10 +189,10 @@ let check_override_field ctx p rctx =
valid_redefinition rctx.map rctx.map rctx.cf_new rctx.cf_new.cf_type rctx.cf_old rctx.t_old;
with
Unify_error l ->
(* TODO construct error with sub *)
display_error ctx.com ("Field " ^ i ^ " overrides parent class with different or incomplete type") p;
display_error ~depth:1 ctx.com (compl_msg "Base field is defined here") rctx.cf_old.cf_name_pos;
display_error ~depth:1 ctx.com (compl_msg (error_msg (Unify l))) p
display_error_ext ctx.com (make_error (Custom ("Field " ^ i ^ " overrides parent class with different or incomplete type")) ~sub:([
(make_error ~depth:1 (Custom (compl_msg (error_msg (Unify l)))) p);
(make_error ~depth:1 (Custom (compl_msg "Base field is defined here")) rctx.cf_old.cf_name_pos);
]) p)

let find_override_field ctx c_new cf_new c_old tl get_super_field is_overload p =
let i = cf_new.cf_name in
Expand Down Expand Up @@ -400,10 +400,10 @@ module Inheritance = struct
with
Unify_error l ->
if not ((has_class_flag c CExtern)) then begin
(* TODO construct error with sub *)
display_error com ("Field " ^ f.cf_name ^ " has different type than in " ^ s_type_path intf.cl_path) p;
display_error ~depth:1 com (compl_msg "Interface field is defined here") f.cf_pos;
display_error ~depth:1 com (compl_msg (error_msg (Unify l))) p;
display_error_ext com (make_error (Custom ("Field " ^ f.cf_name ^ " has different type than in " ^ s_type_path intf.cl_path)) ~sub:([
(make_error ~depth:1 (Custom (compl_msg (error_msg (Unify l)))) p);
(make_error ~depth:1 (Custom (compl_msg "Interface field is defined here")) f.cf_name_pos);
]) p)
end
)
with Not_found ->
Expand Down Expand Up @@ -490,20 +490,19 @@ module Inheritance = struct
let display = ctx.com.display_information in
display.module_diagnostics <- MissingFields diag :: display.module_diagnostics
| l ->
let singular = match l with [_] -> true | _ -> false in
display_error ctx.com (Printf.sprintf "This class extends abstract class %s but doesn't implement the following method%s" (s_type_path csup.cl_path) (if singular then "" else "s")) c.cl_name_pos;
(* TODO sub error ? *)
display_error ctx.com (Printf.sprintf "Implement %s or make %s abstract as well" (if singular then "it" else "them") (s_type_path c.cl_path)) c.cl_name_pos;
let pctx = print_context() in
List.iter (fun (cf,_) ->
let sub = List.map (fun (cf,_) ->
let s = match follow cf.cf_type with
| TFun(tl,tr) ->
String.concat ", " (List.map (fun (n,o,t) -> Printf.sprintf "%s:%s" n (s_type pctx t)) tl)
| t ->
s_type pctx t
in
display_error ~depth:1 ctx.com (compl_msg (Printf.sprintf "%s(%s)" cf.cf_name s)) cf.cf_name_pos
) (List.rev !missing)
make_error ~depth:1 (Custom (compl_msg (Printf.sprintf "%s(%s)" cf.cf_name s))) cf.cf_name_pos
) !missing in
let singular = match l with [_] -> true | _ -> false in
let sub = [make_error (Custom (Printf.sprintf "Implement %s or make %s abstract as well" (if singular then "it" else "them") (s_type_path c.cl_path))) ~sub c.cl_name_pos] in
display_error_ext ctx.com (make_error (Custom (Printf.sprintf "This class extends abstract class %s but doesn't implement the following method%s" (s_type_path csup.cl_path) (if singular then "" else "s"))) ~sub c.cl_name_pos)

let set_heritance ctx c herits p =
let is_lib = Meta.has Meta.LibType c.cl_meta in
Expand Down Expand Up @@ -644,10 +643,13 @@ let check_final_vars ctx e =
Type.iter find_inits e
in
find_inits e;
if Hashtbl.length final_vars > 0 then
display_error ctx.com "Some final fields are uninitialized in this class" ctx.c.curclass.cl_name_pos;
DynArray.iter (fun (c,cf) ->
if Hashtbl.mem final_vars cf.cf_name then
display_error ~depth:1 ctx.com "Uninitialized field" cf.cf_name_pos
) ordered_fields
if Hashtbl.length final_vars > 0 then begin
let sub = List.filter_map (fun (c,cf) ->
if Hashtbl.mem final_vars cf.cf_name then
Some (make_error ~depth:1 (Custom "Uninitialized field") cf.cf_name_pos)
else
None
) (DynArray.to_list ordered_fields) in
display_error_ext ctx.com (make_error (Custom "Some final fields are uninitialized in this class") ~sub:(List.rev sub) ctx.c.curclass.cl_name_pos)
end
end
Loading

0 comments on commit 603f6f6

Please sign in to comment.