[server] improve dirty tracking

src/compiler/compilationCache.ml

@@ -160,10 +160,10 @@ class cache = object(self)
 			) cc#get_modules acc
 		) contexts []
 
-	method taint_modules file_key =
+	method taint_modules file_key reason =
 		Hashtbl.iter (fun _ cc ->
 			Hashtbl.iter (fun _ m ->
-				if Path.UniqueKey.lazy_key m.m_extra.m_file = file_key then m.m_extra.m_dirty <- Some m.m_path
+				if Path.UniqueKey.lazy_key m.m_extra.m_file = file_key then m.m_extra.m_dirty <- Some (Tainted reason)
 			) cc#get_modules
 		) contexts
 

src/compiler/server.ml

@@ -10,7 +10,7 @@ open Json
 open Compiler
 open CompilationContext
 
-exception Dirty of path
+exception Dirty of module_skip_reason
 exception ServerError of string
 
 let has_error ctx =
@@ -320,7 +320,7 @@ let check_module sctx ctx m p =
 				let time = file_time file in
 				if time > m.m_extra.m_time then begin
 					ServerMessage.module_path_changed com "" (m,time,file);
-					raise Not_found
+					raise (Dirty (Shadowed file))
 				end
 			end
 		) paths
@@ -334,27 +334,26 @@ let check_module sctx ctx m p =
 			| MFake | MImport -> () (* don't get classpath *)
 			| MExtern ->
 				(* if we have a file then this will override our extern type *)
-				let has_file = (try check_module_shadowing directories m; false with Not_found -> true) in
-				if has_file then begin
-					if sctx.verbose then print_endline ("A file is masking the library file " ^ s_type_path m.m_path); (* TODO *)
-					raise Not_found;
-				end;
+				check_module_shadowing directories m;
 				let rec loop = function
 					| [] ->
 						if sctx.verbose then print_endline ("No library file was found for " ^ s_type_path m.m_path); (* TODO *)
-						raise Not_found (* no extern registration *)
+						raise (Dirty LibraryChanged)
 					| (file,load) :: l ->
 						match load m.m_path p with
-						| None -> loop l
+						| None ->
+							loop l
 						| Some _ ->
 							if com.file_keys#get file <> (Path.UniqueKey.lazy_key m.m_extra.m_file) then begin
 								if sctx.verbose then print_endline ("Library file was changed for " ^ s_type_path m.m_path); (* TODO *)
-								raise Not_found;
+								raise (Dirty LibraryChanged)
 							end
 				in
 				loop com.load_extern_type
-			| MCode -> check_module_shadowing directories m
-			| MMacro when ctx.Typecore.in_macro -> check_module_shadowing directories m
+			| MCode ->
+				check_module_shadowing directories m
+			| MMacro when ctx.Typecore.in_macro ->
+				check_module_shadowing directories m
 			| MMacro ->
 				(*
 					Creating another context while the previous one is incomplete means we have an infinite loop in the compiler.
@@ -381,14 +380,14 @@ let check_module sctx ctx m p =
 				end else begin
 					ServerMessage.not_cached com "" m;
 					if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.lazy_key m.m_extra.m_file);
-					raise Not_found;
+					raise (Dirty (FileChanged file))
 				end
 			end
 		in
 		let check_dependencies () =
 			PMap.iter (fun _ m2 -> match check m2 with
 				| None -> ()
-				| Some path -> raise (Dirty path)
+				| Some _ -> raise (Dirty (DependencyDirty m2.m_path))
 			) m.m_extra.m_deps;
 		in
 		begin match m.m_extra.m_dirty with
@@ -407,12 +406,9 @@ let check_module sctx ctx m p =
 				if not (has_policy NoCheckDependencies) then check_dependencies();
 				None
 			with
-			| Not_found ->
-				m.m_extra.m_dirty <- Some m.m_path;
-				Some m.m_path
-			| Dirty path ->
-				m.m_extra.m_dirty <- Some path;
-				Some path
+			| Dirty reason ->
+				m.m_extra.m_dirty <- Some reason;
+				Some reason
 			end
 	in
 	check m
@@ -466,8 +462,8 @@ let type_module sctx (ctx:Typecore.typer) mpath p =
 		let tcheck = Timer.timer ["server";"module cache";"check"] in
 		begin match check_module sctx ctx m p with
 		| None -> ()
-		| Some path ->
-			ServerMessage.skipping_dep com "" (m,path);
+		| Some reason ->
+			ServerMessage.skipping_dep com "" (m,(Printer.s_module_skip_reason reason));
 			tcheck();
 			raise Not_found;
 		end;

src/compiler/serverMessage.ml

@@ -85,8 +85,8 @@ let removed_directory com tabs dir =
 let reusing com tabs m =
 	if config.print_reusing then print_endline (Printf.sprintf "%s%sreusing %s" (sign_string com) tabs (s_type_path m.m_path))
 
-let skipping_dep com tabs (m,path) =
-	if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s%s" (sign_string com) (s_type_path m.m_path) (if m.m_path = path then "" else Printf.sprintf "(%s)" (s_type_path path)))
+let skipping_dep com tabs (m,reason) =
+	if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s (%s)" (sign_string com) (s_type_path m.m_path) reason)
 
 let unchanged_content com tabs file =
 	if config.print_unchanged_content then print_endline (Printf.sprintf "%s%s changed time not but content, reusing" (sign_string com) file)

src/context/display/displayJson.ml

@@ -218,7 +218,7 @@ let handler =
 			let file = hctx.jsonrpc#get_string_param "file" in
 			let fkey = hctx.com.file_keys#get file in
 			let cs = hctx.display#get_cs in
-			cs#taint_modules fkey;
+			cs#taint_modules fkey "server/invalidate";
 			cs#remove_files fkey;
 			hctx.send_result jnull
 		);

src/context/display/displayTexpr.ml

@@ -167,7 +167,7 @@ let check_display_file ctx cs =
 			let fkey = DisplayPosition.display_position#get_file_key in
 			(* force parsing again : if the completion point have been changed *)
 			cs#remove_files fkey;
-			cs#taint_modules fkey;
+			cs#taint_modules fkey "check_display_file";
 		end
 	| None ->
 		()

src/core/tPrinting.ml

@@ -632,12 +632,19 @@ module Printer = struct
 		| MExtern -> "MExtern"
 		| MImport -> "MImport"
 
+	let s_module_skip_reason = function
+		| DependencyDirty path -> "DependencyDirty " ^ (s_type_path path)
+		| Tainted cause -> "Tainted " ^ cause
+		| FileChanged file -> "FileChanged " ^ file
+		| Shadowed file -> "Shadowed " ^ file
+		| LibraryChanged -> "LibraryChanged"
+
 	let s_module_def_extra tabs me =
 		s_record_fields tabs [
 			"m_file",Path.UniqueKey.lazy_path me.m_file;
 			"m_sign",me.m_sign;
 			"m_time",string_of_float me.m_time;
-			"m_dirty",s_opt s_type_path me.m_dirty;
+			"m_dirty",s_opt s_module_skip_reason me.m_dirty;
 			"m_added",string_of_int me.m_added;
 			"m_mark",string_of_int me.m_mark;
 			"m_deps",s_pmap string_of_int (fun m -> snd m.m_path) me.m_deps;

src/core/tType.ml

@@ -31,6 +31,13 @@ type module_check_policy =
 	| NoCheckDependencies
 	| NoCheckShadowing
 
+type module_skip_reason =
+	| DependencyDirty of path
+	| Tainted of string
+	| FileChanged of string
+	| Shadowed of string
+	| LibraryChanged
+
 type t =
 	| TMono of tmono
 	| TEnum of tenum * tparams
@@ -356,7 +363,7 @@ and module_def_extra = {
 	m_display : module_def_display;
 	mutable m_check_policy : module_check_policy list;
 	mutable m_time : float;
-	mutable m_dirty : path option;
+	mutable m_dirty : module_skip_reason option;
 	mutable m_added : int;
 	mutable m_mark : int;
 	mutable m_deps : (int,module_def) PMap.t;

src/macro/macroApi.ml

@@ -1986,7 +1986,7 @@ let macro_api ccom get_api =
 			List.iter (fun v ->
 				let s = decode_string v in
 				let s = com.file_keys#get s in
-				cs#taint_modules s;
+				cs#taint_modules s "server_invalidate_files";
 				cs#remove_files s;
 			) (decode_array a);
 			vnull

tests/server/src/SkipReason.hx

@@ -0,0 +1,8 @@
+
+enum SkipReason {
+	DependencyDirty(path:String);
+	Tainted(cause:String);
+	FileChanged(file:String);
+	Shadowed(file:String);
+	LibraryChanged;
+}

tests/server/src/TestCase.hx

@@ -1,3 +1,4 @@
+import SkipReason;
 import haxe.PosInfos;
 import haxe.Exception;
 import haxe.display.Position;
@@ -30,6 +31,16 @@ class TestCase implements ITest {
 
 	public function new() {}
 
+	static public function printSkipReason(ddr:SkipReason) {
+		return switch (ddr) {
+			case DependencyDirty(path): 'DependencyDirty $path';
+			case Tainted(cause): 'Tainted $cause';
+			case FileChanged(file): 'FileChanged $file';
+			case Shadowed(file): 'Shadowed $file';
+			case LibraryChanged: 'LibraryChanged';
+		}
+	}
+
 	public function setup() {
 		testDir = "test/cases/" + i++;
 		vfs = new Vfs(testDir);
@@ -165,11 +176,8 @@ class TestCase implements ITest {
 		Assert.isTrue(hasMessage('reusing $module'), null, p);
 	}
 
-	function assertSkipping(module:String, ?dependency:String, ?p:haxe.PosInfos) {
-		var msg = 'skipping $module';
-		if (dependency != null) {
-			msg += '($dependency)';
-		}
+	function assertSkipping(module:String, reason:SkipReason, ?p:haxe.PosInfos) {
+		var msg = 'skipping $module (${printSkipReason(reason))})';
 		Assert.isTrue(hasMessage(msg), null, p);
 	}
 

tests/server/src/cases/ServerTests.hx

@@ -25,7 +25,7 @@ class ServerTests extends TestCase {
 		runHaxe(args);
 		runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("HelloWorld.hx")});
 		runHaxe(args);
-		assertSkipping("HelloWorld");
+		assertSkipping("HelloWorld", Tainted("server/invalidate"));
 		// assertNotCacheModified("HelloWorld");
 	}
 
@@ -36,7 +36,7 @@ class ServerTests extends TestCase {
 		runHaxe(args);
 		runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
 		runHaxe(args);
-		assertSkipping("WithDependency", "Dependency");
+		assertSkipping("WithDependency", DependencyDirty("Dependency"));
 		// assertNotCacheModified("Dependency");
 		runHaxe(args);
 		assertReuse("Dependency");
@@ -82,8 +82,8 @@ class ServerTests extends TestCase {
 		runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("BuildMacro.hx")});
 		runHaxe(args);
 		// assertNotCacheModified("BuildMacro");
-		assertSkipping("BuiltClass", "BuildMacro");
-		assertSkipping("BuildMacro");
+		assertSkipping("BuiltClass", DependencyDirty("BuildMacro"));
+		assertSkipping("BuildMacro", Tainted("server/invalidate"));
 	}
 
 	function testBrokenSyntaxDiagnostics() {
@@ -123,7 +123,7 @@ class ServerTests extends TestCase {
 		runHaxe(args2);
 
 		runHaxe(args);
-		assertSkipping("HelloWorld");
+		assertSkipping("HelloWorld", Tainted("check_display_file"));
 	}
 
 	function testMutuallyDependent() {
@@ -146,7 +146,7 @@ class ServerTests extends TestCase {
 		assertReuse("HelloWorld");
 	 	runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("HelloWorld.hx")});
 	 	runHaxe(args);
-	 	assertSkipping("HelloWorld");
+	 	assertSkipping("HelloWorld", Tainted("server/invalidate"));
 		runHaxe(args.concat(["--display", "HelloWorld.hx@0@diagnostics"]));
 		runHaxe(args);
 		assertReuse("HelloWorld");

tests/server/src/cases/issues/Issue8748.hx

@@ -19,7 +19,7 @@ class Issue8748 extends TestCase {
 		runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("res/dep.dep")});
 		runHaxeJson(args, DisplayMethods.Hover, {file: new FsPath("WithDependency.hx"), offset: 65});
 		// check messages manually because module file contains awkward absolute path
-		var r = ~/skipping Dependency\(.*dep.dep\)/;
+		var r = ~/skipping Dependency \(.*dep.dep\)/;
 		Assert.isTrue(messages.exists(message -> r.match(message)));
 	}
 }