From db842bfd6c815784f16da415d6718bcb7d393a66 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Thu, 18 Apr 2024 15:00:36 +0200 Subject: [PATCH] Cleanup error positions (#11630) * Add and use file_pos and fake_pos instead of manually creating pos objects * [Pretty errors] Don't try to display position source when pos points to file itself * [tests] update tests --- src/codegen/javaModern.ml | 12 +-- src/codegen/swfLoader.ml | 2 +- src/compiler/args.ml | 2 +- src/compiler/compiler.ml | 2 +- src/compiler/displayProcessing.ml | 2 +- src/compiler/hxb/hxbWriter.ml | 2 +- src/compiler/messageReporting.ml | 92 ++++++++++--------- src/context/commonCache.ml | 2 +- src/context/display/displayPath.ml | 2 +- src/context/display/documentSymbols.ml | 2 +- src/core/globals.ml | 4 +- src/macro/eval/evalDebugSocket.ml | 2 +- src/typing/macroContext.ml | 2 +- src/typing/typeloadParse.ml | 2 +- .../Issue8303/pretty-fail.hxml.stderr | 4 +- 15 files changed, 65 insertions(+), 69 deletions(-) diff --git a/src/codegen/javaModern.ml b/src/codegen/javaModern.ml index 8fbd3cb81b6..e03926e85a3 100644 --- a/src/codegen/javaModern.ml +++ b/src/codegen/javaModern.ml @@ -754,11 +754,7 @@ module Converter = struct tp let convert_enum (jc : jclass) (file : string) = - let p = { - pfile = file; - pmin = 0; - pmax = 0 - } in + let p = file_pos file in let meta = ref [] in let add_meta m = meta := m :: !meta in let data = ref [] in @@ -920,11 +916,7 @@ module Converter = struct cff let convert_class ctx (jc : jclass) (file : string) = - let p = { - pfile = file; - pmin = 0; - pmax = 0 - } in + let p = file_pos file in let flags = ref [HExtern] in let meta = ref [] in let add_flag f = flags := f :: !flags in diff --git a/src/codegen/swfLoader.ml b/src/codegen/swfLoader.ml index fe0e05b8268..fa9ba999f0d 100644 --- a/src/codegen/swfLoader.ml +++ b/src/codegen/swfLoader.ml @@ -147,7 +147,7 @@ let is_valid_path com pack name = let build_class com c file = let path = (make_tpath c.hlc_name).path in - let pos = { pfile = file ^ "@" ^ s_type_path (path.tpackage,path.tname); pmin = 0; pmax = 0 } in + let pos = file_pos (file ^ "@" ^ s_type_path (path.tpackage,path.tname)) in match path with | { tpackage = ["flash";"utils"]; tname = ("Object"|"Function") } -> let inf = { diff --git a/src/compiler/args.ml b/src/compiler/args.ml index c3de78ce41e..3f95944aa54 100644 --- a/src/compiler/args.ml +++ b/src/compiler/args.ml @@ -293,7 +293,7 @@ let parse_args com = ),"","set current working directory"); ("Compilation",["--haxelib-global"],[], Arg.Unit (fun () -> ()),"","pass --global argument to haxelib"); ("Compilation",["-w"],[], Arg.String (fun s -> - let p = { pfile = "-w " ^ s; pmin = 0; pmax = 0 } in + let p = fake_pos ("-w " ^ s) in let l = Warning.parse_options s p in com.warning_options <- l :: com.warning_options ),"","enable or disable specific warnings"); diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index f780a042459..57c89dae094 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -275,7 +275,7 @@ let check_defines com = PMap.iter (fun k _ -> try let reason = Hashtbl.find Define.deprecation_lut k in - let p = { pfile = "-D " ^ k; pmin = -1; pmax = -1 } in + let p = fake_pos ("-D " ^ k) in com.warning WDeprecatedDefine [] reason p with Not_found -> () diff --git a/src/compiler/displayProcessing.ml b/src/compiler/displayProcessing.ml index 7e345a0f8e6..fc3ea076fdc 100644 --- a/src/compiler/displayProcessing.ml +++ b/src/compiler/displayProcessing.ml @@ -244,7 +244,7 @@ let load_display_file_standalone (ctx : Typecore.typer) file = let load_display_content_standalone (ctx : Typecore.typer) input = let com = ctx.com in let file = file_input_marker in - let p = {pfile = file; pmin = 0; pmax = 0} in + let p = file_pos file in let parsed = TypeloadParse.parse_file_from_string com file p input in let pack,decls = TypeloadParse.handle_parser_result com p parsed in ignore(TypeloadModule.type_module ctx.com ctx.g (pack,"?DISPLAY") file ~dont_check_path:true decls p) diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index 723b7d91aa0..222cff951b4 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -1122,7 +1122,7 @@ module HxbWriter = struct end with Not_found -> (try ignore(IdentityPool.get writer.unbound_ttp ttp) with Not_found -> begin ignore(IdentityPool.add writer.unbound_ttp ttp ()); - let p = { null_pos with pfile = (Path.UniqueKey.lazy_path writer.current_module.m_extra.m_file) } in + let p = file_pos (Path.UniqueKey.lazy_path writer.current_module.m_extra.m_file) in let msg = Printf.sprintf "Unbound type parameter %s" (s_type_path ttp.ttp_class.cl_path) in writer.warn WUnboundTypeParameter msg p end); diff --git a/src/compiler/messageReporting.ml b/src/compiler/messageReporting.ml index f7f76d31123..2d9ecc80f3e 100644 --- a/src/compiler/messageReporting.ml +++ b/src/compiler/messageReporting.ml @@ -4,54 +4,57 @@ open Common open CompilationContext let resolve_source file l1 p1 l2 p2 = - let ch = open_in_bin file in - let curline = ref 1 in - let lines = ref [] in - let rec loop p line = - let inc i line = - if (!curline >= l1) && (!curline <= l2) then lines := (!curline, line) :: !lines; - curline := !curline + 1; - (i, "") - in - - let input_char_or_done ch line = - try input_char ch with End_of_file -> begin - ignore(inc 0 line); - raise End_of_file - end - in + if l1 = l2 && p1 = p2 && l1 = 1 && p1 = 1 then [] + else begin + let ch = open_in_bin file in + let curline = ref 1 in + let lines = ref [] in + let rec loop p line = + let inc i line = + if (!curline >= l1) && (!curline <= l2) then lines := (!curline, line) :: !lines; + curline := !curline + 1; + (i, "") + in - let read_char line = match input_char_or_done ch line with - | '\n' -> inc 1 line - | '\r' -> - ignore(input_char_or_done ch line); - inc 2 line - | c -> begin - let line = ref (line ^ (String.make 1 c)) in - let rec skip n = - if n > 0 then begin - let c = input_char_or_done ch !line in - line := !line ^ (String.make 1 c); - skip (n - 1) - end - in + let input_char_or_done ch line = + try input_char ch with End_of_file -> begin + ignore(inc 0 line); + raise End_of_file + end + in - let code = int_of_char c in - if code < 0xC0 then () - else if code < 0xE0 then skip 1 - else if code < 0xF0 then skip 2 - else skip 3; + let read_char line = match input_char_or_done ch line with + | '\n' -> inc 1 line + | '\r' -> + ignore(input_char_or_done ch line); + inc 2 line + | c -> begin + let line = ref (line ^ (String.make 1 c)) in + let rec skip n = + if n > 0 then begin + let c = input_char_or_done ch !line in + line := !line ^ (String.make 1 c); + skip (n - 1) + end + in + + let code = int_of_char c in + if code < 0xC0 then () + else if code < 0xE0 then skip 1 + else if code < 0xF0 then skip 2 + else skip 3; + + (1, !line) + end + in - (1, !line) - end + let (delta, line) = read_char line in + loop (p + delta) line in - let (delta, line) = read_char line in - loop (p + delta) line - in - - try loop 0 ""; with End_of_file -> close_in ch; - List.rev !lines + try loop 0 ""; with End_of_file -> close_in ch; + List.rev !lines + end let resolve_file ctx f = let ext = StringHelper.extension f in @@ -100,7 +103,8 @@ let compiler_pretty_message_string com ectx cm = let l1, p1, l2, p2 = Lexer.get_pos_coords cm.cm_pos in let lines = resolve_source f l1 p1 l2 p2 in let epos = - if ectx.absolute_positions then TPrinting.Printer.s_pos cm.cm_pos + if lines = [] then cm.cm_pos.pfile + else if ectx.absolute_positions then TPrinting.Printer.s_pos cm.cm_pos else Lexer.get_error_pos error_printer cm.cm_pos in (l1, p1, l2, p2, epos, lines) diff --git a/src/context/commonCache.ml b/src/context/commonCache.ml index d2c7db7796c..a0c92924b55 100644 --- a/src/context/commonCache.ml +++ b/src/context/commonCache.ml @@ -11,7 +11,7 @@ class lib_build_task cs file ftime lib = object(self) let h = Hashtbl.create 0 in List.iter (fun path -> if not (Hashtbl.mem h path) then begin - let p = { pfile = file ^ " @ " ^ Globals.s_type_path path; pmin = 0; pmax = 0; } in + let p = file_pos (file ^ " @ " ^ Globals.s_type_path path) in try begin match lib#build path p with | Some r -> Hashtbl.add h path r | None -> () diff --git a/src/context/display/displayPath.ml b/src/context/display/displayPath.ml index 27c2cf784d9..e6c0c99f618 100644 --- a/src/context/display/displayPath.ml +++ b/src/context/display/displayPath.ml @@ -189,7 +189,7 @@ let handle_path_display ctx path p = (* We assume that we want to go to the module file, not a specific type which might not even exist anyway. *) let mt = ctx.g.do_load_module ctx (sl,s) p in - let p = { pfile = (Path.UniqueKey.lazy_path mt.m_extra.m_file); pmin = 0; pmax = 0} in + let p = file_pos (Path.UniqueKey.lazy_path mt.m_extra.m_file) in raise_positions [p] | (IDKModule(sl,s),_),DMHover -> let m = ctx.g.do_load_module ctx (sl,s) p in diff --git a/src/context/display/documentSymbols.ml b/src/context/display/documentSymbols.ml index 4d61a6ae4ef..d93c8b4fe92 100644 --- a/src/context/display/documentSymbols.ml +++ b/src/context/display/documentSymbols.ml @@ -114,7 +114,7 @@ let collect_module_symbols mname with_locals (pack,decls) = ) decls; begin match mname with | Some(file,mname) when not (Hashtbl.mem type_decls mname) -> - add mname Module {pfile = file; pmin = 0; pmax = 0} (String.concat "." pack) false + add mname Module (file_pos file) (String.concat "." pack) false | _ -> () end; diff --git a/src/core/globals.ml b/src/core/globals.ml index c7a557298c7..3c474d8512d 100644 --- a/src/core/globals.ml +++ b/src/core/globals.ml @@ -30,7 +30,9 @@ let version_minor = (version mod 1000) / 100 let version_revision = (version mod 100) let version_pre = Some "alpha.1" -let null_pos = { pfile = "?"; pmin = -1; pmax = -1 } +let file_pos file = { pfile = file; pmin = 0; pmax = 0 } +let fake_pos p = { pfile = p; pmin = -1; pmax = -1 } +let null_pos = fake_pos "?" let no_color = false let c_reset = if no_color then "" else "\x1b[0m" diff --git a/src/macro/eval/evalDebugSocket.ml b/src/macro/eval/evalDebugSocket.ml index 55be0d1cb98..880b66b651d 100644 --- a/src/macro/eval/evalDebugSocket.ml +++ b/src/macro/eval/evalDebugSocket.ml @@ -473,7 +473,7 @@ module ValueCompletion = struct exception JsonException of Json.t let get_completion ctx text column env = - let p = { pmin = 0; pmax = 0; pfile = "" } in + let p = file_pos "" in let save = let old = !Parser.display_mode,DisplayPosition.display_position#get in (fun () -> diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 260fdda1b52..d9f307b2b0e 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -1010,7 +1010,7 @@ let call_macro mctx args margs call p = call (List.map (fun e -> try Interp.make_const e with Exit -> raise_typing_error "Argument should be a constant" e.epos) el) let resolve_init_macro com e = - let p = { pfile = "--macro " ^ e; pmin = -1; pmax = -1 } in + let p = fake_pos ("--macro " ^ e) in let e = try if String.get e (String.length e - 1) = ';' then raise_typing_error "Unexpected ;" p; begin match ParserEntry.parse_expr_string com.defines e p raise_typing_error false with diff --git a/src/typing/typeloadParse.ml b/src/typing/typeloadParse.ml index cfad8bff5f1..869a7f892b2 100644 --- a/src/typing/typeloadParse.ml +++ b/src/typing/typeloadParse.ml @@ -39,7 +39,7 @@ let parse_file_from_lexbuf com file p lexbuf = with | Sedlexing.MalFormed -> t(); - raise_typing_error "Malformed file. Source files must be encoded with UTF-8." {pfile = file; pmin = 0; pmax = 0} + raise_typing_error "Malformed file. Source files must be encoded with UTF-8." (file_pos file) | e -> t(); raise e diff --git a/tests/misc/projects/Issue8303/pretty-fail.hxml.stderr b/tests/misc/projects/Issue8303/pretty-fail.hxml.stderr index f3f273aa2cf..2cd268477fb 100644 --- a/tests/misc/projects/Issue8303/pretty-fail.hxml.stderr +++ b/tests/misc/projects/Issue8303/pretty-fail.hxml.stderr @@ -2,10 +2,8 @@ | Uncaught exception Stack overflow - -> Main.hx:1: character 1 + -> Main.hx - 1 | class Main { - | ^ | Called from here 8 | log();