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