generalize `@:coreApi` (see 4066)

codegen.ml

@@ -152,7 +152,7 @@ let extend_remoting ctx c t p async prot =
 		Error (Module_not_found _,p2) when p == p2 ->
 	(* build it *)
 	Common.log ctx.com ("Building proxy for " ^ s_type_path path);
-	let file, decls = (try
+	let _, file, decls = (try
 		Typeload.parse_module ctx path p
 	with
 		| Not_found -> ctx.com.package_rules <- rules; error ("Could not load proxy module " ^ s_type_path path ^ (if fst path = [] then " (try using absolute path)" else "")) p
@@ -203,7 +203,7 @@ let extend_remoting ctx c t p async prot =
 			(EClass { c with d_flags = []; d_name = new_name; d_data = fields },p)
 		| _ -> d
 	) decls in
-	let m = Typeload.type_module ctx (t.tpackage,new_name) file decls p in
+	let m = Typeload.type_module ctx (t.tpackage,new_name) file "" decls p in
 	add_dependency ctx.m.curmod m;
 	try
 		List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.m_types

common.ml

@@ -130,7 +130,7 @@ type context = {
 	mutable print : string -> unit;
 	mutable get_macros : unit -> context option;
 	mutable run_command : string -> int;
-	file_lookup_cache : (string,string option) Hashtbl.t;
+	file_lookup_cache : (string,(string * string) option) Hashtbl.t;
 	mutable stored_typed_exprs : (int, texpr) PMap.t;
 	(* output *)
 	mutable file : string;
@@ -951,7 +951,7 @@ let add_filter ctx f =
 let add_final_filter ctx f =
 	ctx.final_filters <- f :: ctx.final_filters
 
-let find_file ctx f =
+let find_file' ctx f =
 	try
 		(match Hashtbl.find ctx.file_lookup_cache f with
 		| None -> raise Exit
@@ -965,7 +965,7 @@ let find_file ctx f =
 			| p :: l ->
 				let file = p ^ f in
 				if Sys.file_exists file then
-					file
+					file,p
 				else
 					loop (had_empty || p = "") l
 		in
@@ -975,6 +975,8 @@ let find_file ctx f =
 		| None -> raise Not_found
 		| Some f -> f)
 
+let find_file ctx f =
+	fst (find_file' ctx f)
 
 let get_full_path f = try Extc.get_full_path f with _ -> f
 

main.ml

@@ -725,7 +725,7 @@ and wait_loop boot_com host port =
 		Hashtbl.replace cache.c_modules (m.m_path,m.m_extra.m_sign) m;
 	in
 	let check_module_path com m p =
-		if m.m_extra.m_file <> Common.unique_full_path (Typeload.resolve_module_file com m.m_path (ref[]) p) then begin
+		if m.m_extra.m_file <> Common.unique_full_path (fst (Typeload.resolve_module_file com m.m_path (ref[]) p)) then begin
 			if verbose then print_endline ("Module path " ^ s_type_path m.m_path ^ " has been changed");
 			raise Not_found;
 		end

tests/misc/projects/Issue4066/Main.hx

@@ -0,0 +1,10 @@
+class Main {
+	static function main() {
+		var a = new A();
+		function print(s) {
+			Sys.stderr().writeString(s + "\n");
+		}
+		print(a.doSomething());
+		print(a.doSomethingElse());
+	}
+}

tests/misc/projects/Issue4066/compile.hxml

@@ -0,0 +1,4 @@
+-main Main
+-cp src1
+-cp src2
+--interp

tests/misc/projects/Issue4066/compile.hxml.stderr

@@ -0,0 +1,2 @@
+ok
+Never mind, do something else.

tests/misc/projects/Issue4066/src1/A.hx

@@ -0,0 +1,14 @@
+class A {
+
+	public function new() { }
+
+	public function doSomething() {
+		return "DO SOMETHING ALREADY!";
+	}
+
+	@:astSource
+	public function doSomethingElse() {
+		return "Never mind, do something else.";
+	}
+
+}

tests/misc/projects/Issue4066/src2/A.hx

@@ -0,0 +1,13 @@
+package;
+
+@:coreApi
+class A {
+
+	public function new() { }
+
+	public function doSomething():String {
+		return "ok";
+	}
+
+	public function doSomethingElse():String @:useAstSource @:coreApi A.doSomethingElse;
+}

type.ml

@@ -290,6 +290,7 @@ and module_def_extra = {
 	mutable m_macro_calls : string list;
 	mutable m_if_feature : (string *(tclass * tclass_field * bool)) list;
 	mutable m_features : (string,bool) Hashtbl.t;
+	mutable m_used_class_path : string;
 }
 
 and module_kind =
@@ -390,6 +391,7 @@ let module_extra file sign time kind =
 		m_macro_calls = [];
 		m_if_feature = [];
 		m_features = Hashtbl.create 0;
+		m_used_class_path = "";
 	}
 
 

typeload.ml

@@ -1653,7 +1653,7 @@ let load_core_class ctx c =
 			Common.define com2 Define.CoreApi;
 			Common.define com2 Define.Sys;
 			if ctx.in_macro then Common.define com2 Define.Macro;
-			com2.class_path <- ctx.com.std_path;
+			com2.class_path <- List.filter (fun s -> s <> c.cl_module.m_extra.m_used_class_path) ctx.com.class_path;
 			let ctx2 = ctx.g.do_create com2 in
 			ctx.g.core_api <- Some ctx2;
 			ctx2
@@ -3184,9 +3184,10 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 				error "Abstract is missing underlying type declaration" a.a_pos
 		end
 
-let type_module ctx m file ?(is_extern=false) tdecls p =
+let type_module ctx m file used_class_path ?(is_extern=false) tdecls p =
 	let m, decls, tdecls = make_module ctx m file tdecls p in
 	if is_extern then m.m_extra.m_kind <- MExtern;
+	m.m_extra.m_used_class_path <- used_class_path;
 	add_module ctx m p;
 	(* define the per-module context for the next pass *)
 	let ctx = {
@@ -3253,10 +3254,8 @@ let type_module ctx m file ?(is_extern=false) tdecls p =
 	List.iter (init_module_type ctx context_init do_init) tdecls;
 	m
 
-
-let resolve_module_file com m remap p =
-	let forbid = ref false in
-	let file = (match m with
+let file_path_of_module com m remap forbid =
+	(match m with
 		| [] , name -> name
 		| x :: l , name ->
 			let x = (try
@@ -3267,8 +3266,12 @@ let resolve_module_file com m remap p =
 				with Not_found -> x
 			) in
 			String.concat "/" (x :: l) ^ "/" ^ name
-	) ^ ".hx" in
-	let file = Common.find_file com file in
+	) ^ ".hx"
+
+let resolve_module_file com m remap p =
+	let forbid = ref false in
+	let file = file_path_of_module com m remap forbid in
+	let file,used_class_path = Common.find_file' com file in
 	let file = (match String.lowercase (snd m) with
 	| "con" | "aux" | "prn" | "nul" | "com1" | "com2" | "com3" | "lpt1" | "lpt2" | "lpt3" when Sys.os_type = "Win32" ->
 		(* these names are reserved by the OS - old DOS legacy, such files cannot be easily created but are reported as visible *)
@@ -3297,11 +3300,11 @@ let resolve_module_file com m remap p =
 			raise (Forbid_package ((x,m,p),[],if Common.defined com Define.Macro then "macro" else platform_name com.platform));
 		end;
 	end;
-	file
+	file,used_class_path
 
 let parse_module ctx m p =
 	let remap = ref (fst m) in
-	let file = resolve_module_file ctx.com m remap p in
+	let file,used_class_path = resolve_module_file ctx.com m remap p in
 	let pack, decls = (!parse_hook) ctx.com file p in
 	if pack <> !remap then begin
 		let spack m = if m = [] then "<empty>" else String.concat "." m in
@@ -3310,7 +3313,7 @@ let parse_module ctx m p =
 		else
 			display_error ctx ("Invalid package : " ^ spack (fst m) ^ " should be " ^ spack pack) p
 	end;
-	file, if !remap <> fst m then
+	file, used_class_path, if !remap <> fst m then
 		(* build typedefs to redirect to real package *)
 		List.rev (List.fold_left (fun acc (t,p) ->
 			let build f d =
@@ -3351,7 +3354,7 @@ let load_module ctx m p =
 			| Some m -> m
 			| None ->
 			let is_extern = ref false in
-			let file, decls = (try
+			let file, used_class_path, decls = (try
 				parse_module ctx m p
 			with Not_found ->
 				let rec loop = function
@@ -3360,14 +3363,14 @@ let load_module ctx m p =
 					| load :: l ->
 						match load m p with
 						| None -> loop l
-						| Some (file,(_,a)) -> file, a
+						| Some (file,(_,a)) -> "", file, a
 				in
 				is_extern := true;
 				loop ctx.com.load_extern_type
 			) in
 			let is_extern = !is_extern in
 			try
-				type_module ctx m file ~is_extern decls p
+				type_module ctx m file used_class_path ~is_extern decls p
 			with Forbid_package (inf,pl,pf) when p <> Ast.null_pos ->
 				raise (Forbid_package (inf,p::pl,pf))
 	) in

typer.ml

@@ -385,7 +385,7 @@ let eval ctx s =
 		| None -> error "Evaluated string did not define any types" p
 		| Some path -> path
 	in
-	ignore(Typeload.type_module ctx path_module "eval" decls p);
+	ignore(Typeload.type_module ctx path_module "eval" "" decls p);
 	flush_pass ctx PBuildClass "eval"
 
 let parse_expr_string ctx s p inl =
@@ -4631,7 +4631,7 @@ let make_macro_api ctx p =
 			let m, tdef, pos = (try Interp.decode_type_def v with Interp.Invalid_expr -> Interp.exc (Interp.VString "Invalid type definition")) in
 			let add ctx =
 				let prev = (try Some (Hashtbl.find ctx.g.modules m) with Not_found -> None) in
-				let mnew = Typeload.type_module ctx m ctx.m.curmod.m_extra.m_file [tdef,pos] pos in
+				let mnew = Typeload.type_module ctx m ctx.m.curmod.m_extra.m_file "" [tdef,pos] pos in
 				add_dependency mnew ctx.m.curmod;
 				(* if we defined a type in an existing module, let's move the types here *)
 				(match prev with
@@ -4663,7 +4663,7 @@ let make_macro_api ctx p =
 			let types = imports @ usings @ types in
 			let m = Ast.parse_path m in
 			let prev = (try Some (Hashtbl.find ctx.g.modules m) with Not_found -> None) in
-			let mnew = Typeload.type_module ctx m ctx.m.curmod.m_extra.m_file types pos in
+			let mnew = Typeload.type_module ctx m ctx.m.curmod.m_extra.m_file "" types pos in
 			add_dependency mnew ctx.m.curmod;
 			(* if we defined a type in an existing module, let's move the types here *)
 			(match prev with