Browse Source

refactor TyperDotPath (closes #9189, closes #9190) (#9191)

* refactor TyperDotPath (closes #9189, closes #9190)

* use correct position for sub-type access

* shut up Issue4720 test for now

this is a separate issue with deprecation warning duplicates that was surfaced by fixing positions in resolved dotpaths

* adapt test position

* improve "sensible error" algorithm

and add a TODO because it should not be needed if we raise proper errors instead of Not_found

* improve error position for the "sensible error"

* fix deprecation warning test
Dan Korostelev 5 years ago
parent
commit
55b45250f2

+ 4 - 15
src/typing/calls.ml

@@ -878,20 +878,9 @@ let array_access ctx e1 e2 mode p =
 (*
 (*
 	given chain of fields as the `path` argument and an `access_mode->access_kind` getter for some starting expression as `e`,
 	given chain of fields as the `path` argument and an `access_mode->access_kind` getter for some starting expression as `e`,
 	return a new `access_mode->access_kind` getter for the whole field access chain.
 	return a new `access_mode->access_kind` getter for the whole field access chain.
-
-	if `resume` is true, `Not_found` will be raised if the first field in chain fails to resolve, in all other
-	cases, normal type errors will be raised if a field can't be accessed.
 *)
 *)
-let field_chain ?(resume=false) ctx path e =
-	let resume = ref resume in
-	let force = ref false in
-	let e = List.fold_left (fun e (f,_,p) ->
+let field_chain ctx path e =
+	List.fold_left (fun e (f,_,p) ->
 		let e = acc_get ctx (e MGet) p in
 		let e = acc_get ctx (e MGet) p in
-		let f = type_field (TypeFieldConfig.create !resume) ctx e f p in
-		force := !resume;
-		resume := false;
-		f
-	) e path in
-	if !force then ignore(e MCall); (* not necessarily a call, but prevent #2602 among others *)
-	e
-
+		type_field_default_cfg ctx e f p
+	) e path

+ 65 - 29
src/typing/typeload.ml

@@ -121,36 +121,72 @@ let find_type_in_current_module_context ctx pack name =
 		ImportHandling.mark_import_position ctx pi;
 		ImportHandling.mark_import_position ctx pi;
 		t
 		t
 
 
-let load_unqualified_type_def ctx mname tname p =
-	try
-		let rec loop l =
-			match l with
-			| [] ->
-				raise Exit
-			| (pack,ppack) :: l ->
-				begin try
-					let mt = load_type ctx (pack,mname) tname p in
-					ImportHandling.mark_import_position ctx ppack;
-					mt
-				with Not_found ->
-					loop l
-				end
-		in
-		(* Check wildcard packages by using their package *)
-		loop ctx.m.wildcard_packages
-	with Exit ->
-		let rec loop l =
-			match l with
-			| [] ->
-				load_type_raise ctx ([],mname) tname p
-			| _ :: sl as l ->
+let find_in_wildcard_imports ctx mname p f =
+	let rec loop l =
+		match l with
+		| [] ->
+			raise Not_found
+		| (pack,ppack) :: l ->
+			begin
+			try
+				let path = (pack,mname) in
+				let m =
+					try
+						ctx.g.do_load_module ctx path p
+					with Error (Module_not_found mpath,_) when mpath = path ->
+						raise Not_found
+				in
+				let r = f m ~resume:true in
+				ImportHandling.mark_import_position ctx ppack;
+				r
+			with Not_found ->
+				loop l
+			end
+	in
+	loop ctx.m.wildcard_packages
+
+(* TODO: move these generic find functions into a separate module *)
+let find_in_modules_starting_from_current_package ~resume ctx mname p f =
+	let rec loop l =
+		let path = (List.rev l,mname) in
+		match l with
+		| [] ->
+			let m =
 				try
 				try
-					load_type ctx (List.rev l,mname) tname p
-				with Not_found ->
-					loop sl
-		in
-		(* Check our current module's path and its parent paths *)
-		loop (List.rev (fst ctx.m.curmod.m_path))
+					ctx.g.do_load_module ctx path p
+				with Error (Module_not_found mpath,_) when resume && mpath = path ->
+					raise Not_found
+			in
+			f m ~resume:resume
+		| _ :: sl ->
+			try
+				let m =
+					try
+						ctx.g.do_load_module ctx path p
+					with Error (Module_not_found mpath,_) when mpath = path ->
+						raise Not_found
+					in
+				f m ~resume:true;
+			with Not_found ->
+				loop sl
+	in
+	let pack = fst ctx.m.curmod.m_path in
+	loop (List.rev pack)
+
+let find_in_unqualified_modules ctx name p f ~resume =
+	try
+		find_in_wildcard_imports ctx name p f
+	with Not_found ->
+		find_in_modules_starting_from_current_package ctx name p f ~resume:resume
+
+let load_unqualified_type_def ctx mname tname p =
+	let find_type m ~resume =
+		if resume then
+			find_type_in_module m tname
+		else
+			find_type_in_module_raise m tname p
+	in
+	find_in_unqualified_modules ctx mname p find_type ~resume:false
 
 
 let load_module ctx path p =
 let load_module ctx path p =
 	try
 	try

+ 26 - 11
src/typing/typer.ml

@@ -1267,21 +1267,36 @@ and handle_efield ctx e p0 mode =
 			with Not_found ->
 			with Not_found ->
 				(* dot-path resolution failed, it could be an untyped field access that happens to look like a dot-path, e.g. `untyped __global__.String` *)
 				(* dot-path resolution failed, it could be an untyped field access that happens to look like a dot-path, e.g. `untyped __global__.String` *)
 				try
 				try
+					(* TODO: we don't really want to do full type_ident again, just the second part of it *)
 					field_chain ctx pnext (type_ident ctx name p)
 					field_chain ctx pnext (type_ident ctx name p)
 				with Error (Unknown_ident _,p2) as e when p = p2 ->
 				with Error (Unknown_ident _,p2) as e when p = p2 ->
 					try
 					try
 						(* try raising a more sensible error if there was an uppercase-first (module name) part *)
 						(* try raising a more sensible error if there was an uppercase-first (module name) part *)
-						let pack_acc = ref [] in
-						let name , _ , _ = List.find (fun (name,case,p) ->
-							if case = PUppercase then
-								true
-							else begin
-								pack_acc := name :: !pack_acc;
-								false
-							end
-						) path in
-						let pack = List.rev !pack_acc in
-						raise (Error (Module_not_found (pack,name),p))
+						begin
+							(* TODO: we should pass the actual resolution error from resolve_dot_path instead of Not_found *)
+							let rec loop pack_acc first_uppercase path =
+								match path with
+								| (name,PLowercase,_) :: rest ->
+									(match first_uppercase with
+									| None -> loop (name :: pack_acc) None rest
+									| Some (n,p) -> List.rev pack_acc, n, None, p)
+								| (name,PUppercase,p) :: rest ->
+									(match first_uppercase with
+									| None -> loop pack_acc (Some (name,p)) rest
+									| Some (n,_) -> List.rev pack_acc, n, Some name, p)
+								| [] ->
+									(match first_uppercase with
+									| None -> raise Not_found
+									| Some (n,p) -> List.rev pack_acc, n, None, p)
+							in
+							let pack,name,sub,p = loop [] None path in
+							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),p))
+							else
+								raise (Error (Module_not_found mpath,p))
+						end
 					with Not_found ->
 					with Not_found ->
 						(* if there was no module name part, last guess is that we're trying to get package completion *)
 						(* if there was no module name part, last guess is that we're trying to get package completion *)
 						if ctx.in_display then begin
 						if ctx.in_display then begin

+ 4 - 0
src/typing/typerBase.ml

@@ -144,6 +144,10 @@ let rec type_module_type ctx t tparams p =
 let type_type ctx tpath p =
 let type_type ctx tpath p =
 	type_module_type ctx (Typeload.load_type_def ctx p { tpackage = fst tpath; tname = snd tpath; tparams = []; tsub = None }) None p
 	type_module_type ctx (Typeload.load_type_def ctx p { tpackage = fst tpath; tname = snd tpath; tparams = []; tsub = None }) None p
 
 
+let mk_module_type_access ctx t p : access_mode -> access_kind =
+	let e = type_module_type ctx t None p in
+	(fun _ -> AKExpr e)
+
 let s_access_kind acc =
 let s_access_kind acc =
 	let st = s_type (print_context()) in
 	let st = s_type (print_context()) in
 	let se = s_expr_pretty true "" false st in
 	let se = s_expr_pretty true "" false st in

+ 56 - 85
src/typing/typerDotPath.ml

@@ -17,8 +17,11 @@
 	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *)
 *)
 open Globals
 open Globals
+open Type
+open TType
 open TyperBase
 open TyperBase
 open Calls
 open Calls
+open Fields
 open TFunctions
 open TFunctions
 open Error
 open Error
 
 
@@ -32,14 +35,50 @@ let mk_dot_path_part s p : dot_path_part =
 	let case = if is_lower_ident s p then PLowercase else PUppercase in
 	let case = if is_lower_ident s p then PLowercase else PUppercase in
 	(s,case,p)
 	(s,case,p)
 
 
-(* given a list of dot path parts, try to resolve it into access getter, raises Not_found on failure *)
+let s_dot_path parts =
+	String.concat "." (List.map (fun (s,_,_) -> s) parts)
+
+let resolve_module_type ctx m name p =
+	let t = Typeload.find_type_in_module m name in (* raises Not_found *)
+	mk_module_type_access ctx t p
+
+let resolve_in_module ctx m path p =
+	let mname = snd m.m_path in
+	match path with
+	| (sname,PUppercase,sp) :: path_rest ->
+		begin
+		try
+			resolve_module_type ctx m sname sp, path_rest
+		with Not_found ->
+			resolve_module_type ctx m mname p, path
+		end
+	| _ ->
+		resolve_module_type ctx m mname p, path
+
+(** resolve given qualified module pack+name (and possibly next path part) or raise Not_found *)
+let resolve_qualified ctx pack name next_path p =
+	try
+		let m = Typeload.load_module ctx (pack,name) p in
+		resolve_in_module ctx m next_path p
+	with Error (Module_not_found mpath,_) when mpath = (pack,name) ->
+		(* might be an instance of https://github.com/HaxeFoundation/haxe/issues/9150
+		   so let's also check (pack,name) of a TYPE in the current module context ¯\_(ツ)_/¯ *)
+		let t = Typeload.find_type_in_current_module_context ctx pack name in (* raises Not_found *)
+		mk_module_type_access ctx t p, next_path
+
+(** resolve the given unqualified name (and possibly next path part) or raise Not_found *)
+let resolve_unqualified ctx name next_path p =
+	try
+		(* if there's a type with this name in current module context - simply resolve against it *)
+		let t = Typeload.find_type_in_current_module_context ctx [] name in (* raises Not_found *)
+		mk_module_type_access ctx t p, next_path
+	with Not_found ->
+		(* otherwise run the unqualified module resolution mechanism and look into the modules  *)
+		let f m ~resume = resolve_in_module ctx m next_path p in
+		Typeload.find_in_unqualified_modules ctx name p f ~resume:true (* raise Not_found *)
+
+(** given a list of dot path parts, resolve it into access getter or raise Not_found *)
 let resolve_dot_path ctx (path_parts : dot_path_part list) =
 let resolve_dot_path ctx (path_parts : dot_path_part list) =
-	(*
-		we rely on the fact that packages start with a lowercase letter, while modules and types start with uppercase letters,
-		so we processes path parts, accumulating lowercase parts in `pack_acc`, until we encounter an upper-case part,
-		which can mean either a module access or module's primary type access, so we try to figure out the type and
-		resolve the rest of the field access chain against it.
-	*)
 	let rec loop pack_acc path =
 	let rec loop pack_acc path =
 		match path with
 		match path with
 		| (_,PLowercase,_) as x :: path ->
 		| (_,PLowercase,_) as x :: path ->
@@ -47,87 +86,19 @@ let resolve_dot_path ctx (path_parts : dot_path_part list) =
 			loop (x :: pack_acc) path
 			loop (x :: pack_acc) path
 
 
 		| (name,PUppercase,p) :: path ->
 		| (name,PUppercase,p) :: path ->
-			(* part starts with uppercase - it either points to a module or its main type *)
-
-			let pack = List.rev_map (fun (x,_,_) -> x) pack_acc in
-
-			(* default behaviour: try loading module's primary type (with the same name as module)
-				and resolve the rest of the field chain against its statics (or return the type itself
-				if the rest of chain is empty) *)
-			let def () =
-				try
-					let e = type_type ctx (pack,name) p in
-					field_chain ctx path (fun _ -> AKExpr e)
-				with
-					Error (Module_not_found m,_) when m = (pack,name) ->
-						(* not a module path after all *)
-						raise Not_found
+			(* part starts with uppercase - it's a module name - try resolving *)
+			let accessor, path_rest =
+				if pack_acc <> [] then
+					let pack = List.rev_map (fun (x,_,_) -> x) pack_acc in
+					resolve_qualified ctx pack name path p
+				else
+					resolve_unqualified ctx name path p
 			in
 			in
-
-			(match path with
-			| (sname,PUppercase,p) :: path ->
-				(* next part starts with uppercase, meaning it can be either a module sub-type access
-					or static field access for the primary module type, so we have to do some guessing here
-
-					In this block, `name` is the first first-uppercase part (possibly a module name),
-					and `sname` is the second first-uppsercase part (possibly a subtype name). *)
-
-				(* get static field by `sname` from a given type `t`, if `resume` is true - raise Not_found *)
-				let get_static resume t =
-					field_chain ctx ~resume ((sname,PUppercase,p) :: path) (fun _ -> AKExpr (type_module_type ctx t None p))
-				in
-
-				(* try accessing subtype or main class static field by `sname` in given module with path `m` *)
-				let check_module m =
-					try
-						let md = Typeload.load_module ctx m p in
-						(* first look for existing subtype *)
-						(try
-							let t = Typeload.find_type_in_module md sname in
-							Some (field_chain ctx path (fun _ -> AKExpr (type_module_type ctx t None p)))
-						with Not_found -> try
-						(* then look for main type statics *)
-							if fst m = [] then raise Not_found; (* ensure that we use def() to resolve local types first *)
-							let t = Typeload.find_type_in_module md (snd m) in
-							Some (get_static false t)
-						with Not_found ->
-							None)
-					with Error (Module_not_found m2,_) when m = m2 ->
-						None
-				in
-
-				(match pack with
-				| [] ->
-					(* no package was specified - Unqualified access *)
-					(try
-						(* first try getting the type from the current module context
-						   and try accessing its static field by `sname` *)
-						let t = Typeload.find_type_in_current_module_context ctx pack name in
-						get_static true t
-					with Not_found ->
-						(* if the static field (or the type) wasn't not found, look for a subtype instead - #1916
-							look for subtypes/main-class-statics in modules of current package and its parent packages *)
-						let rec loop pack =
-							match check_module (pack,name) with
-							| Some r -> r
-							| None ->
-								match List.rev pack with
-								| [] -> def()
-								| _ :: l -> loop (List.rev l)
-						in
-						loop (fst ctx.m.curmod.m_path))
-				| _ ->
-					(* if package was specified - Qualified access *)
-					(match check_module (pack,name) with
-					| Some r -> r
-					| None -> def ()));
-			| _ -> 
-				(* no more parts or next part starts with lowercase - it's surely not a type name, so do the default thing *)
-				def())
+			(* if we get here (that is, Not_found is not raised) - we have something to resolve against *)
+			field_chain ctx path_rest accessor
 
 
 		| [] ->
 		| [] ->
-			(* if we get to here, it means that there was no uppercase parts, so it's not a qualified dot-path *)
+			(* if we get to here, it means that there was no uppercase part, so it's not a qualified dot-path *)
 			raise Not_found
 			raise Not_found
-
 	in
 	in
 	loop [] path_parts
 	loop [] path_parts

+ 1 - 0
std/php/_std/haxe/io/BytesBuffer.hx

@@ -23,6 +23,7 @@
 package haxe.io;
 package haxe.io;
 
 
 import php.*;
 import php.*;
+import haxe.io.Error;
 
 
 class BytesBuffer {
 class BytesBuffer {
 	var b:NativeString;
 	var b:NativeString;

+ 1 - 1
tests/misc/projects/Issue2087/compile-fail.hxml.stderr

@@ -1 +1 @@
-Main.hx:3: characters 3-7 : Type not found : haxe.Resauce
+Main.hx:3: characters 3-15 : Type not found : haxe.Resauce

+ 2 - 2
tests/misc/projects/Issue4720/compile.hxml.stderr

@@ -2,7 +2,7 @@ Main.hx:8: characters 9-15 : Warning : Usage of this typedef is deprecated
 Main.hx:9: characters 9-19 : Warning : Usage of this typedef is deprecated
 Main.hx:9: characters 9-19 : Warning : Usage of this typedef is deprecated
 Main.hx:10: characters 9-14 : Warning : Usage of this typedef is deprecated
 Main.hx:10: characters 9-14 : Warning : Usage of this typedef is deprecated
 Main.hx:18: characters 13-19 : Warning : This typedef is deprecated in favor of MyClass
 Main.hx:18: characters 13-19 : Warning : This typedef is deprecated in favor of MyClass
-Main.hx:19: characters 9-19 : Warning : Usage of this typedef is deprecated
+Main.hx:19: characters 9-14 : Warning : Usage of this typedef is deprecated
 Main.hx:20: characters 13-22 : Warning : This typedef is deprecated in favor of MyAbstract
 Main.hx:20: characters 13-22 : Warning : This typedef is deprecated in favor of MyAbstract
 Main.hx:32: characters 9-13 : Warning : Usage of this enum is deprecated
 Main.hx:32: characters 9-13 : Warning : Usage of this enum is deprecated
 Main.hx:36: characters 9-14 : Warning : Usage of this enum field is deprecated
 Main.hx:36: characters 9-14 : Warning : Usage of this enum field is deprecated
@@ -10,7 +10,7 @@ Main.hx:4: characters 9-16 : Warning : Usage of this class is deprecated
 Main.hx:5: characters 9-20 : Warning : Usage of this class is deprecated
 Main.hx:5: characters 9-20 : Warning : Usage of this class is deprecated
 Main.hx:6: characters 9-15 : Warning : Usage of this enum is deprecated
 Main.hx:6: characters 9-15 : Warning : Usage of this enum is deprecated
 Main.hx:15: characters 9-22 : Warning : Usage of this class is deprecated
 Main.hx:15: characters 9-22 : Warning : Usage of this class is deprecated
-Main.hx:16: characters 9-20 : Warning : Usage of this enum is deprecated
+Main.hx:16: characters 9-15 : Warning : Usage of this enum is deprecated
 Main.hx:17: characters 9-29 : Warning : Usage of this class is deprecated
 Main.hx:17: characters 9-29 : Warning : Usage of this class is deprecated
 Main.hx:18: characters 9-21 : Warning : Usage of this class is deprecated
 Main.hx:18: characters 9-21 : Warning : Usage of this class is deprecated
 Main.hx:20: characters 9-28 : Warning : Usage of this class is deprecated
 Main.hx:20: characters 9-28 : Warning : Usage of this class is deprecated

+ 1 - 0
tests/misc/resolution/projects/Issue9189/compile-fail.hxml

@@ -0,0 +1 @@
+-main pack.Main

+ 1 - 0
tests/misc/resolution/projects/Issue9189/compile-fail.hxml.stderr

@@ -0,0 +1 @@
+pack/Main.hx:8: characters 13-14 : Class<otherPack.Mod> has no field A

+ 5 - 0
tests/misc/resolution/projects/Issue9189/otherPack/Mod.hx

@@ -0,0 +1,5 @@
+package otherPack;
+
+class Mod {
+	public function new() {}
+}

+ 10 - 0
tests/misc/resolution/projects/Issue9189/pack/Main.hx

@@ -0,0 +1,10 @@
+package pack;
+
+import otherPack.*;
+
+class Main {
+	static function main() {
+		trace(new Mod());
+		trace(Mod.A);
+	}
+}

+ 5 - 0
tests/misc/resolution/projects/Issue9189/pack/Mod.hx

@@ -0,0 +1,5 @@
+package pack;
+
+class Mod {
+	public static final A = 3;
+}

+ 1 - 0
tests/misc/resolution/projects/spec/Wildcard.hx

@@ -6,6 +6,7 @@ import utest.Assert;
 class Wildcard extends utest.Test {
 class Wildcard extends utest.Test {
     function test() {
     function test() {
         Macro.assert("InnerMod");
         Macro.assert("InnerMod");
+        Macro.assert("InnerMod.InnerModSubType");
         Assert.isFalse(Macro.resolves("InnerModSubType"));
         Assert.isFalse(Macro.resolves("InnerModSubType"));
         Assert.isFalse(Macro.resolves("InnerModNoMainSubType"));
         Assert.isFalse(Macro.resolves("InnerModNoMainSubType"));
         Assert.isTrue(Macro.resolves("InnerModNoValue"));
         Assert.isTrue(Macro.resolves("InnerModNoValue"));