[message reporting] Update sub errors handling (#11595)

* 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

src/compiler/compiler.ml

@@ -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

src/filters/localStatic.ml

@@ -1,4 +1,3 @@
-open Common
 open Type
 open Typecore
 open Error
@@ -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;

src/optimization/analyzerTexpr.ml

@@ -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;

src/optimization/inlineConstructors.ml

@@ -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

src/typing/callUnification.ml

@@ -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)) }
@@ -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
@@ -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()
@@ -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;
 		);

src/typing/fields.ml

@@ -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
 			)

src/typing/generic.ml

@@ -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
@@ -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

src/typing/typeload.ml

@@ -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
@@ -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 ->
@@ -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
@@ -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

src/typing/typeloadCheck.ml

@@ -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
@@ -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
@@ -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 ->
@@ -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
@@ -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