From 52e3eed824d54bb8072fc34407a2935a49c9ad84 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sat, 12 Apr 2025 08:33:22 +0200 Subject: [PATCH 1/5] remove err_depth --- src/compiler/compiler.ml | 4 ++-- src/compiler/messageReporting.ml | 2 +- src/context/common.ml | 6 +++--- src/context/typecore.ml | 4 ++-- src/core/error.ml | 23 +++++++++++------------ src/filters/safe/localStatic.ml | 2 +- src/generators/gctx.ml | 2 +- src/macro/eval/evalMain.ml | 4 +--- src/macro/macroApi.ml | 11 ++++------- src/optimization/analyzerTexpr.ml | 2 +- src/optimization/inlineConstructors.ml | 2 +- src/typing/callUnification.ml | 7 +++---- src/typing/fields.ml | 2 +- src/typing/forLoop.ml | 2 +- src/typing/generic.ml | 13 ++++++------- src/typing/macroContext.ml | 4 ++-- src/typing/operators.ml | 4 ++-- src/typing/typeload.ml | 12 ++++++------ src/typing/typeloadCheck.ml | 14 +++++++------- src/typing/typeloadFields.ml | 12 ++++++------ src/typing/typeloadModule.ml | 2 +- src/typing/typer.ml | 2 +- tests/misc/compile.hxml | 2 +- 23 files changed, 65 insertions(+), 73 deletions(-) diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 0ec3f30a45e..b3512a85151 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -252,7 +252,7 @@ module Setup = struct () ); com.error_ext <- error_ext ctx; - com.error <- (fun ?(depth = 0) msg p -> com.error_ext (Error.make_error ~depth (Custom msg) p)); + com.error <- (fun msg p -> com.error_ext (Error.make_error (Custom msg) p)); let filter_messages = (fun keep_errors predicate -> (List.filter (fun cm -> (match cm.cm_severity with | MessageSeverity.Error -> keep_errors; @@ -447,7 +447,7 @@ with ctx.has_error <- false; ctx.messages <- []; end else begin - let sub = List.map (fun p -> Error.make_error ~depth:1 (Error.Custom (Error.compl_msg "referenced here")) p) pl in + let sub = List.map (fun p -> Error.make_error (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 -> diff --git a/src/compiler/messageReporting.ml b/src/compiler/messageReporting.ml index 0cc0fe9b4f8..c9415694bc1 100644 --- a/src/compiler/messageReporting.ml +++ b/src/compiler/messageReporting.ml @@ -340,7 +340,7 @@ let get_formatter defines def default = let print_error (err : Error.error) = let ret = ref "" in - Error.recurse_error (fun depth err -> + Error.recurse_error (fun _ err -> ret := !ret ^ (Lexer.get_error_pos (Printf.sprintf "%s:%d: ") err.err_pos) ^ (Error.error_msg err.err_message) ^ "\n" ) err; !ret diff --git a/src/context/common.ml b/src/context/common.ml index 0cd102e127e..b6b1def7912 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -747,7 +747,7 @@ let create timer_ctx compilation_step cs version args display_mode = info = (fun ?depth ?from_macro _ _ -> die "" __LOC__); warning = (fun ?depth ?from_macro _ _ _ -> die "" __LOC__); warning_options = [List.map (fun w -> {wo_warning = w;wo_mode = WMDisable}) WarningList.disabled_warnings]; - error = (fun ?depth _ _ -> die "" __LOC__); + error = (fun _ _ -> die "" __LOC__); error_ext = (fun _ -> die "" __LOC__); get_messages = (fun() -> []); filter_messages = (fun _ -> ()); @@ -1010,8 +1010,8 @@ let display_error_ext com err = end else com.error_ext err -let display_error com ?(depth = 0) msg p = - display_error_ext com (Error.make_error ~depth (Custom msg) p) +let display_error com msg p = + display_error_ext com (Error.make_error (Custom msg) p) let adapt_defines_to_macro_context defines = let to_remove = "java" :: List.map Globals.platform_name Globals.platforms in diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 21245a0c8f3..c8afb89f105 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -374,8 +374,8 @@ let make_static_field_access c cf t p = let ethis = Texpr.Builder.make_static_this c p in mk (TField (ethis,(FStatic (c,cf)))) t p -let raise_with_type_error ?(depth = 0) msg p = - raise (WithTypeError (make_error ~depth (Custom msg) p)) +let raise_with_type_error msg p = + raise (WithTypeError (make_error (Custom msg) p)) let raise_or_display ctx l p = if ctx.f.untyped then () diff --git a/src/core/error.ml b/src/core/error.ml index e01693ecca2..e72fbdae5ad 100644 --- a/src/core/error.ml +++ b/src/core/error.ml @@ -28,30 +28,29 @@ and type_not_found_reason = type error = { err_message : error_msg; err_pos : pos; - (* TODO Should probably be deprecated at some point and be derived from err_sub *) - err_depth : int; (* Reverse list of sub errors. Use Error.recurse_error to handle an error and its sub errors with depth. *) err_sub : error list; err_from_macro : bool; } -let make_error ?(depth = 0) ?(from_macro = false) ?(sub = []) msg p = { +let make_error ?(from_macro = false) ?(sub = []) msg p = { err_message = msg; err_pos = p; - err_depth = depth; err_from_macro = from_macro; err_sub = sub; } -let rec recurse_error ?(depth = 0) cb err = - let depth = if depth > 0 then depth else err.err_depth in - cb depth err; - List.iter (recurse_error ~depth:(depth+1) cb) (List.rev err.err_sub); +let recurse_error cb err = + let rec loop depth err = + cb depth err; + List.iter (loop (depth+1)) (List.rev err.err_sub) + in + loop 0 err exception Fatal_error of error exception Error of error -let abort ?(depth = 0) msg p = raise (Fatal_error (make_error ~depth (Custom msg) p)) +let abort msg p = raise (Fatal_error (make_error (Custom msg) p)) let string_source t = match follow t with | TInst(c,tl) -> PMap.foldi (fun s _ acc -> s :: acc) (TClass.get_all_fields c tl) [] @@ -320,10 +319,10 @@ and s_call_error = function (* Global error helpers *) let raise_error err = raise (Error err) -let raise_error_msg ?(depth = 0) msg p = raise_error (make_error ~depth msg p) -let raise_msg ?(depth = 0) msg p = raise_error_msg ~depth (Custom msg) p +let raise_error_msg msg p = raise_error (make_error msg p) +let raise_msg msg p = raise_error_msg (Custom msg) p -let raise_typing_error ?(depth = 0) msg p = raise_msg ~depth msg p +let raise_typing_error msg p = raise_msg msg p let raise_typing_error_ext err = raise_error err let raise_std_not_found () = diff --git a/src/filters/safe/localStatic.ml b/src/filters/safe/localStatic.ml index 874d0b49f54..c9e3d43826e 100644 --- a/src/filters/safe/localStatic.ml +++ b/src/filters/safe/localStatic.ml @@ -14,7 +14,7 @@ let promote_local_static lsctx run v eo = begin try let cf = PMap.find name c.cl_statics in 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 + make_error (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 diff --git a/src/generators/gctx.ml b/src/generators/gctx.ml index b947a0be6a9..ee1c54c1e1c 100644 --- a/src/generators/gctx.ml +++ b/src/generators/gctx.ml @@ -9,7 +9,7 @@ type context_main = { } type warning_function = ?depth:int -> ?from_macro:bool -> warning -> Warning.warning_option list list -> string -> pos -> unit -type error_function = ?depth:int -> string -> pos -> unit +type error_function = string -> pos -> unit type t = { platform : platform; diff --git a/src/macro/eval/evalMain.ml b/src/macro/eval/evalMain.ml index 1ed3ff1eb8c..0fb8e3c90a1 100644 --- a/src/macro/eval/evalMain.ml +++ b/src/macro/eval/evalMain.ml @@ -423,10 +423,8 @@ let compiler_error (err : Error.error) = | _ -> let stack = ref [] in - let depth = err.err_depth + 1 in - List.iter (fun err -> - Error.recurse_error ~depth (fun depth err -> + Error.recurse_error (fun depth err -> (* TODO indent child errors depending on depth *) stack := make_runtime_error (Error.error_msg err.err_message) err.err_pos :: !stack; ) err; diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 0065414557d..a744510f4c2 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -65,7 +65,7 @@ type 'value compiler_api = { decode_type : 'value -> t; info : ?depth:int -> string -> pos -> unit; warning : ?depth:int -> Warning.warning -> string -> pos -> unit; - display_error : ?depth:int -> (string -> pos -> unit); + display_error : string -> pos -> unit; with_imports : 'a . import list -> placed_name list list -> (unit -> 'a) -> 'a; with_options : 'a . compiler_options -> (unit -> 'a) -> 'a; exc_string : 'a . string -> 'a; @@ -1799,21 +1799,18 @@ let macro_api ccom get_api = "error", vfun3 (fun msg p depth -> let msg = decode_string msg in let p = decode_pos p in - let depth = decode_int depth in - (get_api()).display_error ~depth msg p; + (get_api()).display_error msg p; raise Abort ); "fatal_error", vfun3 (fun msg p depth -> let msg = decode_string msg in let p = decode_pos p in - let depth = decode_int depth in - raise (Error.Fatal_error (Error.make_error ~depth (Custom msg) p)) + raise (Error.Fatal_error (Error.make_error (Custom msg) p)) ); "report_error", vfun3 (fun msg p depth -> let msg = decode_string msg in let p = decode_pos p in - let depth = decode_int depth in - (get_api()).display_error ~depth msg p; + (get_api()).display_error msg p; vnull ); "warning", vfun3 (fun msg p depth -> diff --git a/src/optimization/analyzerTexpr.ml b/src/optimization/analyzerTexpr.ml index 24df7ec2ebe..62eb87ce722 100644 --- a/src/optimization/analyzerTexpr.ml +++ b/src/optimization/analyzerTexpr.ml @@ -1248,7 +1248,7 @@ module Purity = struct apply_to_class c with Purity_conflict(impure,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 + Error.make_error (Custom (Error.compl_msg "Pure field is here")) p ] impure.pn_field.cf_pos) end | _ -> () diff --git a/src/optimization/inlineConstructors.ml b/src/optimization/inlineConstructors.ml index 2d929f279f6..359ff8e9338 100644 --- a/src/optimization/inlineConstructors.ml +++ b/src/optimization/inlineConstructors.ml @@ -131,7 +131,7 @@ let inline_constructors (scom : SafeCom.t) original_e = List.iter (fun v -> if v.v_id < 0 then cancel_v v p) io.io_dependent_vars; if ioc.ioc_forced then begin SafeCom.add_error scom (make_error (Custom "Forced inline constructor could not be inlined") ~sub:([ - (make_error ~depth:1 (Custom (compl_msg "Cancellation happened here")) p) + (make_error (Custom (compl_msg "Cancellation happened here")) p) ]) io.io_pos); end | _ -> () diff --git a/src/typing/callUnification.ml b/src/typing/callUnification.ml index 62208cc6a76..d185999c1bd 100644 --- a/src/typing/callUnification.ml +++ b/src/typing/callUnification.ml @@ -407,13 +407,12 @@ let unify_field_call ctx fa el_typed el p inline = | None -> let sub = List.fold_left (fun acc (cf,err) -> (make_error - ~depth:1 (* pretty much optional here *) ~sub:[err] (Custom ("Overload resolution failed for " ^ (s_type (print_context()) cf.cf_type))) p ) :: acc ) [] failures in - let sub = (make_error ~depth:1 (Custom "End of overload failure reasons") p) :: sub in + let sub = (make_error (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 @@ -428,7 +427,7 @@ let unify_field_call ctx fa el_typed el p inline = | fcc :: l -> let st = s_type (print_context()) in let sub = List.map (fun fcc -> - make_error ~depth:1 (Custom (compl_msg (st fcc.fc_type))) fcc.fc_field.cf_name_pos + make_error (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 @@ -512,7 +511,7 @@ object(self) 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 } + old { err with err_sub = (make_error (Custom (compl_msg "Called from macro here")) p) :: err.err_sub } end else old err; ); diff --git a/src/typing/fields.ml b/src/typing/fields.ml index 0b79edb66aa..bdd51abc925 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -222,7 +222,7 @@ let field_access ctx mode f fh e pfield = (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_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 + make_error (Custom "Add @:isVar here to enable it") f.cf_pos ] pfield); end; normal false diff --git a/src/typing/forLoop.ml b/src/typing/forLoop.ml index da586c69450..f67487a5f8e 100644 --- a/src/typing/forLoop.ml +++ b/src/typing/forLoop.ml @@ -119,7 +119,7 @@ module IterationKind = struct | Some e -> e | None -> if resume then raise Not_found; - display_error_ext ctx.com (make_error ~depth:err.err_depth ~sub:[err] (Custom "Field iterator has an invalid type") acc_expr.epos); + display_error_ext ctx.com (make_error ~sub:[err] (Custom "Field iterator has an invalid type") acc_expr.epos); mk (TConst TNull) t_dynamic p ) in diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 905dd1da58b..812735c6772 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -352,7 +352,7 @@ let build_generic_class ctx c p tl = 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) -> 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) + (make_error (Custom (compl_msg (Printf.sprintf "While building %s" (s_type_path cg.cl_path)))) p) ]) cf_new.cf_pos); | _ -> () @@ -453,10 +453,9 @@ let type_generic_function ctx fa fcc with_type p = let params = extract_type_parameters monos in let unify_existing_field tcf pcf = try unify_raise tcf fc_type p - with Error ({ err_message = Unify _; err_depth = depth } as err) -> + with Error ({ err_message = Unify _ } as err) -> raise (Error { err with err_sub = (make_error - ~depth - ~sub:[make_error ~depth:(depth+1) (Custom (compl_msg "Conflicting field was defined here")) pcf] + ~sub:[make_error (Custom (compl_msg "Conflicting field was defined here")) pcf] (Custom ("Cannot create field " ^ name ^ " due to type mismatch")) p ) :: err.err_sub }) @@ -486,7 +485,7 @@ let type_generic_function ctx fa fcc with_type p = let rec check e = match e.eexpr with | TNew({cl_kind = KTypeParameter _} as c,_,_) when not (TypeloadCheck.is_generic_parameter ctx c) -> 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) + (make_error (Custom (compl_msg "While specializing this call")) p) ]) e.epos); | _ -> Type.iter check e @@ -498,8 +497,8 @@ let type_generic_function ctx fa fcc with_type p = Printf.sprintf "%s = %s" ttp.ttp_name (st t) ) cf.cf_params monos in let sub = [ - (Error.make_error ~depth:1 (Custom (Printf.sprintf "Mapping: %s" (String.concat ", " mappings))) p); - (Error.make_error ~depth:1 (Custom (Printf.sprintf "For function %s.%s" (s_type_path c.cl_path) cf.cf_name)) p); + (Error.make_error (Custom (Printf.sprintf "Mapping: %s" (String.concat ", " mappings))) p); + (Error.make_error (Custom (Printf.sprintf "For function %s.%s" (s_type_path c.cl_path) cf.cf_name)) p); ] in display_error_ext ctx.com (Error.make_error ~sub (Custom "Recursive @:generic function") p); None; | Some e -> diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index a0470ef0fbf..45cd4892e61 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -469,7 +469,7 @@ let make_macro_api ctx mctx p = let m = ctx.com.module_lut#find mpath in let pos = { pfile = (Path.UniqueKey.lazy_path m.m_extra.m_file); pmin = 0; pmax = 0 } in Interp.compiler_error (make_error ~sub:[ - make_error ~depth:1 (Custom "Previously defined here") pos + make_error (Custom "Previously defined here") pos ] (Custom (Printf.sprintf "Cannot redefine module %s" (s_type_path mpath))) p); with Not_found -> ctx.com.cs#taint_module mpath DefineType; @@ -506,7 +506,7 @@ let make_macro_api ctx mctx p = if m != ctx.m.curmod then begin let pos = { pfile = (Path.UniqueKey.lazy_path m.m_extra.m_file); pmin = 0; pmax = 0 } in Interp.compiler_error (make_error ~sub:[ - make_error ~depth:1 (Custom "Previously defined here") pos + make_error (Custom "Previously defined here") pos ] (Custom (Printf.sprintf "Cannot redefine module %s" (s_type_path mpath))) p); end else ignore(TypeloadModule.type_types_into_module ctx.com ctx.g ctx.m.curmod types pos) diff --git a/src/typing/operators.ml b/src/typing/operators.ml index 7fd4e9aa145..2793cb22d94 100644 --- a/src/typing/operators.ml +++ b/src/typing/operators.ml @@ -421,13 +421,13 @@ let find_abstract_binop_overload ctx op e1 e2 a c tl left is_assign_op p = let t_expected = BinopResult.get_type result in begin try unify_raise tret t_expected p - with Error { err_message = Unify _; err_depth = depth } -> + with Error { err_message = Unify _ } -> match follow tret with | TAbstract(a,tl) when type_iseq (Abstract.get_underlying_type a tl) t_expected -> () | _ -> let st = s_type (print_context()) in - raise_typing_error ~depth (Printf.sprintf "The result of this operation (%s) is not compatible with declared return type %s" (st t_expected) (st tret)) p + raise_typing_error (Printf.sprintf "The result of this operation (%s) is not compatible with declared return type %s" (st t_expected) (st tret)) p end; end; (* diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index d5dfb9f847a..66f67a1799b 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -56,7 +56,7 @@ let check_field_access ctx cff = let _,p2 = List.find (fun (access',_) -> access = access') acc in if p1 <> null_pos && p2 <> null_pos then begin 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); + (make_error (Custom (compl_msg "Previously defined here")) p2); ]) p1); end; loop p1 acc l @@ -65,7 +65,7 @@ let check_field_access ctx cff = begin try let _,p2 = List.find (fun (access',_) -> match access' with APublic | APrivate -> true | _ -> false) acc in 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); + (make_error (Custom (compl_msg "Conflicts with this")) p2); ]) p1); loop p1 acc l with Not_found -> @@ -222,8 +222,8 @@ let is_redefined ctx cf1 fields p = let st = s_type (print_context()) in if not (type_iseq cf1.cf_type cf2.cf_type) then begin 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); + (make_error (Custom (compl_msg ("Second type was " ^ (st cf2.cf_type)))) cf2.cf_pos); + (make_error (Custom (compl_msg ("First type was " ^ (st cf1.cf_type)))) cf1.cf_pos); ]) p) end else true @@ -833,7 +833,7 @@ let init_core_api ctx c = raise_typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos | Unify_error l -> 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); + (make_error (Custom (compl_msg (error_msg (Unify l)))) c.cl_pos); ]) c.cl_pos); ) ccore.cl_params c.cl_params; with Invalid_argument _ -> @@ -848,7 +848,7 @@ let init_core_api ctx c = type_eq EqCoreType (apply_params ccore.cl_params (extract_param_types c.cl_params) f.cf_type) f2.cf_type with Unify_error l -> 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); + (make_error (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 diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index 4326efa2760..874a6749df4 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -124,7 +124,7 @@ let copy_meta meta_src meta_target sl = let check_native_name_override ctx child base = let error base_pos child_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) + (make_error (Custom (compl_msg "Base field is defined here")) base_pos) ]) child_pos); in try @@ -181,8 +181,8 @@ let check_override_field ctx p rctx = with Unify_error l -> 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); + (make_error (Custom (compl_msg (error_msg (Unify l)))) p); + (make_error (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 = @@ -392,8 +392,8 @@ module Inheritance = struct Unify_error l -> if not ((has_class_flag c CExtern)) then begin 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); + (make_error (Custom (compl_msg (error_msg (Unify l)))) p); + (make_error (Custom (compl_msg "Interface field is defined here")) f.cf_name_pos); ]) p) end ) @@ -489,7 +489,7 @@ module Inheritance = struct | t -> s_type pctx t in - make_error ~depth:1 (Custom (compl_msg (Printf.sprintf "%s(%s)" cf.cf_name s))) cf.cf_name_pos + make_error (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 @@ -637,7 +637,7 @@ let check_final_vars ctx e = 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) + Some (make_error (Custom "Uninitialized field") cf.cf_name_pos) else None ) (DynArray.to_list ordered_fields) in diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index ce94ac02010..522f8bc88aa 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -313,7 +313,7 @@ let build_enum_abstract ctx c a fields p = () | VPublic(access,p2) | VPrivate(access,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; + make_error (Custom (compl_msg "Conflicts with this")) p2; ] p1) in let rec loop visibility acc = match acc with @@ -554,7 +554,7 @@ let create_typer_context_for_field ctx cctx fctx cff cf = invalid_modifier_combination fctx ctx.com fctx "abstract" "inline" (pos cff.cff_name) else if not (has_class_flag c CAbstract) then begin display_error_ext ctx.com (make_error (Custom "This class should be declared abstract because it has at least one abstract field") ~sub:[ - make_error ~depth:1 (Custom (compl_msg "First abstract field was here")) (pos cff.cff_name); + make_error (Custom (compl_msg "First abstract field was here")) (pos cff.cff_name); ] c.cl_name_pos); add_class_flag c CAbstract; end; @@ -1398,7 +1398,7 @@ let create_property (ctx,cctx,fctx) c f cf (get,set,t,eo) p = (match f2.cf_kind with | Method MethMacro -> display_error_ext ctx.com (make_error (Custom (f2.cf_name ^ ": Macro methods cannot be used as property accessor")) ~sub:[ - make_error ~depth:1 (Custom (compl_msg (f2.cf_name ^ ": Accessor method is here"))) f2.cf_pos; + make_error (Custom (compl_msg (f2.cf_name ^ ": Accessor method is here"))) f2.cf_pos; ] p); | _ -> ()); unify_raise t2 t f2.cf_pos; @@ -1554,7 +1554,7 @@ let check_overload ctx f fs is_extern_class = ) fs in display_error_ext ctx.com (make_error (Custom ("Another overloaded field of same signature was already declared : " ^ f.cf_name)) ~sub:[ - make_error ~depth:1 (Custom (compl_msg "The second field is declared here")) f2.cf_pos; + make_error (Custom (compl_msg "The second field is declared here")) f2.cf_pos; ] f.cf_pos); false with Not_found -> try @@ -1572,7 +1572,7 @@ let check_overload ctx f fs is_extern_class = "Another overloaded field of similar signature was already declared : " ^ f.cf_name ^ "\nThe signatures are different in Haxe, but not in the target language" - )) ~sub:[make_error ~depth:1 (Custom (compl_msg "The second field is declared here")) f2.cf_pos] f.cf_pos); + )) ~sub:[make_error (Custom (compl_msg "The second field is declared here")) f2.cf_pos] f.cf_pos); false with Not_found -> true @@ -1774,7 +1774,7 @@ let init_class ctx_c cctx c p herits fields = display.module_diagnostics <- MissingFields diag :: display.module_diagnostics end else begin display_error_ext com (make_error (Custom "This class has uninitialized final vars, which requires a constructor") ~sub:[ - make_error ~depth:1 (Custom "Example of an uninitialized final var") cf.cf_name_pos; + make_error (Custom "Example of an uninitialized final var") cf.cf_name_pos; ] p); end | _ -> diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index cabd1636b85..f1900e97e3d 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -78,7 +78,7 @@ module ModuleLevel = struct DeprecationCheck.check_is com ctx_m.m.curmod meta [] name meta p; let error prev_pos = raise_typing_error_ext (make_error (Custom ("Name " ^ name ^ " is already defined in this module")) ~sub:[ - make_error ~depth:1 (Custom (compl_msg "Previous declaration here")) prev_pos + make_error (Custom (compl_msg "Previous declaration here")) prev_pos ] p); in DynArray.iter (fun t2 -> diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 8f1dbb938f7..c1851f3a986 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -1041,7 +1041,7 @@ and type_map_declaration ctx e1 el with_type p = try let p = Hashtbl.find keys e_key.eexpr in raise_typing_error_ext (make_error (Custom "Duplicate key") ~sub:[ - make_error ~depth:1 (Custom (compl_msg "Previously defined here")) p + make_error (Custom (compl_msg "Previously defined here")) p ] e_key.epos); with Not_found -> begin match e_key.eexpr with diff --git a/tests/misc/compile.hxml b/tests/misc/compile.hxml index 36ba173c5f7..564445034ca 100644 --- a/tests/misc/compile.hxml +++ b/tests/misc/compile.hxml @@ -1,4 +1,4 @@ -p src #-D MISC_TEST_FILTER=4270 -main Main ---interp \ No newline at end of file +--interp \ No newline at end of file From cf0904cf9458febc159d7b3bade23ae664ddbce7 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Tue, 17 Jun 2025 08:41:08 +0200 Subject: [PATCH 2/5] Update macro API to handle sub errors --- src/context/common.ml | 5 +++-- src/core/error.ml | 10 ++++++++++ src/macro/macroApi.ml | 30 +++++++++++++++++++++--------- std/haxe/macro/Context.hx | 18 ++++++++++++------ 4 files changed, 46 insertions(+), 17 deletions(-) diff --git a/src/context/common.ml b/src/context/common.ml index f935a772676..cf7434d3505 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -18,6 +18,7 @@ *) open Ast open Type +open Error open Globals open Lookup open Define @@ -1092,8 +1093,8 @@ let display_error_ext com err = end else com.error_ext err -let display_error com msg p = - display_error_ext com (Error.make_error (Custom msg) p) +let display_error com ?(sub:macro_error list = []) msg pos = + display_error_ext com (convert_error {msg; pos; sub}) let adapt_defines_to_macro_context defines = let to_remove = "java" :: List.map Globals.platform_name Globals.platforms in diff --git a/src/core/error.ml b/src/core/error.ml index e72fbdae5ad..4326d970de8 100644 --- a/src/core/error.ml +++ b/src/core/error.ml @@ -33,6 +33,12 @@ type error = { err_from_macro : bool; } +type macro_error = { + msg : string; + pos : pos; + sub : macro_error list; +} + let make_error ?(from_macro = false) ?(sub = []) msg p = { err_message = msg; err_pos = p; @@ -40,6 +46,10 @@ let make_error ?(from_macro = false) ?(sub = []) msg p = { err_sub = sub; } +let rec convert_error (err:macro_error) = + let sub = List.map convert_error err.sub in + make_error ~sub (Custom err.msg) err.pos + let recurse_error cb err = let rec loop depth err = cb depth err; diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 348e6dfd3e8..40ce18ab4cb 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -2,6 +2,7 @@ open Ast open DisplayTypes.DisplayMode open Type open Common +open Error open PlatformConfig open DefineList open MetaList @@ -65,7 +66,7 @@ type 'value compiler_api = { decode_type : 'value -> t; info : ?depth:int -> string -> pos -> unit; warning : ?depth:int -> Warning.warning -> string -> pos -> unit; - display_error : string -> pos -> unit; + display_error : ?sub:macro_error list -> string -> pos -> unit; with_imports : 'a . import list -> placed_name list list -> (unit -> 'a) -> 'a; with_options : 'a . compiler_options -> (unit -> 'a) -> 'a; exc_string : 'a . string -> 'a; @@ -73,7 +74,6 @@ type 'value compiler_api = { set_hxb_writer_config : 'value -> unit; } - type enum_type = | IExpr | IEFieldKind @@ -747,6 +747,15 @@ let decode_placed_name vp v = let decode_opt_array f v = if v = vnull then [] else List.map f (decode_array v) +let decode_sub_errors sub = + let rec decode_sub o = + let msg = decode_string (field o "msg") in + let pos = decode_pos (field o "pos") in + let sub = decode_opt_array decode_sub (field o "sub") in + {msg; pos; sub} + in + decode_opt_array decode_sub sub + (* Ast.placed_type_path *) let rec decode_ast_path t = let pack = List.map decode_string (decode_array (field t "pack")) @@ -1800,21 +1809,24 @@ let macro_api ccom get_api = "init_macros_done", vfun0 (fun () -> vbool ((get_api()).init_macros_done ()) ); - "error", vfun3 (fun msg p depth -> + "error", vfun3 (fun msg p sub -> let msg = decode_string msg in let p = decode_pos p in - (get_api()).display_error msg p; + let sub = decode_sub_errors sub in + (get_api()).display_error ~sub msg p; raise Abort ); - "fatal_error", vfun3 (fun msg p depth -> + "fatal_error", vfun3 (fun msg p sub -> let msg = decode_string msg in - let p = decode_pos p in - raise (Error.Fatal_error (Error.make_error (Custom msg) p)) + let pos = decode_pos p in + let sub = decode_sub_errors sub in + raise (Error.Fatal_error (Error.convert_error {msg; pos; sub})) ); - "report_error", vfun3 (fun msg p depth -> + "report_error", vfun3 (fun msg p sub -> let msg = decode_string msg in let p = decode_pos p in - (get_api()).display_error msg p; + let sub = decode_sub_errors sub in + (get_api()).display_error ~sub msg p; vnull ); "warning", vfun3 (fun msg p depth -> diff --git a/std/haxe/macro/Context.hx b/std/haxe/macro/Context.hx index 1c00929a759..d820686ae18 100644 --- a/std/haxe/macro/Context.hx +++ b/std/haxe/macro/Context.hx @@ -30,6 +30,12 @@ enum Message { Warning(msg:String, pos:Position); } +typedef MacroError = { + msg:String, + pos:Position, + ?sub:Array +} + /** Context provides an API for macro programming. @@ -47,24 +53,24 @@ class Context { Displays a compilation error `msg` at the given `Position` `pos` and aborts the current macro call. **/ - public static function error(msg:String, pos:Position, ?depth:Int = 0):Dynamic { - return load("error", 2)(msg, pos, depth); + public static function error(msg:String, pos:Position, ?sub:Array):Dynamic { + return load("error", 2)(msg, pos, sub); } /** Displays a compilation error `msg` at the given `Position` `pos` and aborts the compilation. **/ - public static function fatalError(msg:String, pos:Position, ?depth:Int = 0):Dynamic { - return load("fatal_error", 2)(msg, pos, depth); + public static function fatalError(msg:String, pos:Position, ?sub:Array):Dynamic { + return load("fatal_error", 2)(msg, pos, sub); } /** Displays a compilation error `msg` at the given `Position` `pos` without aborting the current macro call. **/ - public static function reportError(msg:String, pos:Position, ?depth:Int = 0):Void { - load("report_error", 2)(msg, pos, depth); + public static function reportError(msg:String, pos:Position, ?sub:Array):Void { + load("report_error", 2)(msg, pos, sub); } /** From ec794edb4b85504cdfbf41c24534869a65798a1d Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Tue, 17 Jun 2025 08:50:46 +0200 Subject: [PATCH 3/5] err_sub is a reversed list of sub errors --- src/core/error.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/error.ml b/src/core/error.ml index 4326d970de8..98964340f15 100644 --- a/src/core/error.ml +++ b/src/core/error.ml @@ -47,7 +47,7 @@ let make_error ?(from_macro = false) ?(sub = []) msg p = { } let rec convert_error (err:macro_error) = - let sub = List.map convert_error err.sub in + let sub = List.rev_map convert_error err.sub in make_error ~sub (Custom err.msg) err.pos let recurse_error cb err = From 93b1cfae6f75561c52d25ad67224cf7b863a0eeb Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Tue, 17 Jun 2025 08:51:08 +0200 Subject: [PATCH 4/5] Add test --- tests/misc/projects/Issue12167/Main.hx | 13 +++++++++++++ .../misc/projects/Issue12167/compile-fail.hxml | 1 + .../Issue12167/compile-fail.hxml.stderr | 18 ++++++++++++++++++ 3 files changed, 32 insertions(+) create mode 100644 tests/misc/projects/Issue12167/Main.hx create mode 100644 tests/misc/projects/Issue12167/compile-fail.hxml create mode 100644 tests/misc/projects/Issue12167/compile-fail.hxml.stderr diff --git a/tests/misc/projects/Issue12167/Main.hx b/tests/misc/projects/Issue12167/Main.hx new file mode 100644 index 00000000000..f3766109cde --- /dev/null +++ b/tests/misc/projects/Issue12167/Main.hx @@ -0,0 +1,13 @@ +#if !macro +function main() testMacro(); +#end + +macro function testMacro() { + var p1 = (macro "1st position").pos; + var p2 = (macro "2nd position").pos; + haxe.macro.Context.error("Top level error", haxe.macro.Context.currentPos(), [ + {msg: "1st sub error", pos: p1, sub: [{msg: "Nested sub error", pos: p2}]}, + {msg: "2nd sub error", pos: p2} + ]); + return macro null; +} diff --git a/tests/misc/projects/Issue12167/compile-fail.hxml b/tests/misc/projects/Issue12167/compile-fail.hxml new file mode 100644 index 00000000000..42409e72918 --- /dev/null +++ b/tests/misc/projects/Issue12167/compile-fail.hxml @@ -0,0 +1 @@ +-main Main diff --git a/tests/misc/projects/Issue12167/compile-fail.hxml.stderr b/tests/misc/projects/Issue12167/compile-fail.hxml.stderr new file mode 100644 index 00000000000..b082b6b137e --- /dev/null +++ b/tests/misc/projects/Issue12167/compile-fail.hxml.stderr @@ -0,0 +1,18 @@ + ERROR  Main.hx:2: characters 17-28 + + 2 | function main() testMacro(); + | ^^^^^^^^^^^ + | Top level error + + 6 |  var p1 = (macro "1st position").pos; + | ^^^^^^^^^^^^^^ + | 1st sub error + + 7 |  var p2 = (macro "2nd position").pos; + | ^^^^^^^^^^^^^^ + | Nested sub error + + 7 |  var p2 = (macro "2nd position").pos; + | ^^^^^^^^^^^^^^ + | 2nd sub error + From be57fde6138b508bdfd05d4e5fb318e614648e62 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Tue, 17 Jun 2025 08:59:37 +0200 Subject: [PATCH 5/5] Update test --- .../misc/projects/Issue12167/compile-fail.hxml | 2 ++ .../Issue12167/compile-fail.hxml.stderr | 18 +++++++++--------- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/tests/misc/projects/Issue12167/compile-fail.hxml b/tests/misc/projects/Issue12167/compile-fail.hxml index 42409e72918..b66ea29f280 100644 --- a/tests/misc/projects/Issue12167/compile-fail.hxml +++ b/tests/misc/projects/Issue12167/compile-fail.hxml @@ -1 +1,3 @@ -main Main +-D message.reporting=pretty +-D message.no-color diff --git a/tests/misc/projects/Issue12167/compile-fail.hxml.stderr b/tests/misc/projects/Issue12167/compile-fail.hxml.stderr index b082b6b137e..30caceb6f4c 100644 --- a/tests/misc/projects/Issue12167/compile-fail.hxml.stderr +++ b/tests/misc/projects/Issue12167/compile-fail.hxml.stderr @@ -1,18 +1,18 @@ - ERROR  Main.hx:2: characters 17-28 +[ERROR] Main.hx:2: characters 17-28 - 2 | function main() testMacro(); - | ^^^^^^^^^^^ + 2 | function main() testMacro(); + | ^^^^^^^^^^^ | Top level error - 6 |  var p1 = (macro "1st position").pos; - | ^^^^^^^^^^^^^^ + 6 | var p1 = (macro "1st position").pos; + | ^^^^^^^^^^^^^^ | 1st sub error - 7 |  var p2 = (macro "2nd position").pos; - | ^^^^^^^^^^^^^^ + 7 | var p2 = (macro "2nd position").pos; + | ^^^^^^^^^^^^^^ | Nested sub error - 7 |  var p2 = (macro "2nd position").pos; - | ^^^^^^^^^^^^^^ + 7 | var p2 = (macro "2nd position").pos; + | ^^^^^^^^^^^^^^ | 2nd sub error