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

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

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 = {

src/compiler/args.ml

@@ -293,7 +293,7 @@ let parse_args com =
  ),"<directory>","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
  ),"<warning list>","enable or disable specific warnings");

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

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)

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

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)

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

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

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;

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"

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

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

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

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