narrow error positions for "Type not found" (closes #9705)

src/core/error.ml

@@ -290,6 +290,14 @@ let error msg p = raise (Error (Custom msg,p))
 
 let raise_error err p = raise (Error(err,p))
 
+let raise_module_not_found mpath p =
+	let length = String.length (s_type_path mpath) in
+	raise (Error (Module_not_found mpath,narrow_pos p length))
+
+let raise_type_not_found mpath tname reason p =
+	let length = String.length ((s_type_path mpath) ^ "." ^ tname) in
+	raise (Error (Type_not_found (mpath,tname,reason),narrow_pos p length))
+
 let error_require r p =
 	if r = "" then
 		error "This field is not available with the current compilation flags" p

src/core/globals.ml

@@ -73,6 +73,13 @@ let null_pos = { pfile = "?"; pmin = -1; pmax = -1 }
 
 let mk_zero_range_pos p = { p with pmax = p.pmin }
 
+(**
+	Returns position with `pmax` equal or less than `pmin + limit_length`
+*)
+let narrow_pos p limit_length =
+	if p.pmin + limit_length > p.pmax then p
+	else { p with pmax = p.pmin + limit_length }
+
 let s_type_path (p,s) = match p with [] -> s | _ -> String.concat "." p ^ "." ^ s
 
 let starts_with s c =

src/typing/typeload.ml

@@ -92,14 +92,14 @@ let find_type_in_module_raise ctx m tname p =
 			let infos = t_infos mt in
 			if snd infos.mt_path = tname then
 				if ctx.m.curmod != infos.mt_module && infos.mt_private then
-					raise_error (Type_not_found (m.m_path,tname,Private_type)) p
+					raise_type_not_found m.m_path tname Private_type p
 				else
 					true
 			else
 				false
 		) m.m_types
 	with Not_found ->
-		raise_error (Type_not_found (m.m_path,tname,Not_defined)) p
+		raise_type_not_found m.m_path tname Not_defined p
 
 (* raises Module_not_found or Type_not_found *)
 let load_type_raise ctx mpath tname p =

src/typing/typeloadModule.ml

@@ -1072,7 +1072,7 @@ let load_module ctx m p =
 			with Not_found ->
 				let rec loop = function
 					| [] ->
-						raise (Error (Module_not_found m,p))
+						raise_module_not_found m p
 					| (file,load) :: l ->
 						match load m p with
 						| None -> loop l

src/typing/typer.ml

@@ -1362,9 +1362,9 @@ and handle_efield ctx e p0 mode =
 							let mpath = (pack,name) in
 							if Hashtbl.mem ctx.g.modules mpath then
 								let tname = Option.default name sub in
-								raise (Error (Type_not_found (mpath,tname,Not_defined),p))
+								raise_type_not_found mpath tname Not_defined p
 							else
-								raise (Error (Module_not_found mpath,p))
+								raise_module_not_found mpath p
 						end
 					with Not_found ->
 						(* if there was no module name part, last guess is that we're trying to get package completion *)

tests/misc/projects/Issue5644/compile-fail.hxml.stderr

@@ -1,2 +1,2 @@
-User.hx:1: characters 20-47 : Type not found : ThisObviouslyDoesntExist
+User.hx:1: characters 20-44 : Type not found : ThisObviouslyDoesntExist
 Main.hx:1: lines 1-5 : ... Defined in this class

tests/misc/projects/Issue8019/compile2-fail.hxml.stderr

@@ -1 +1 @@
-Main.hx:6: characters 3-19 : Type not found : 0.Foo
+Main.hx:6: characters 3-8 : Type not found : 0.Foo