Преглед изворни кода

[display] turn errors into diagnostics

Simon Krajewski пре 6 година
родитељ
комит
087f80c291
2 измењених фајлова са 23 додато и 8 уклоњено
  1. 17 4
      src/compiler/server.ml
  2. 6 4
      src/context/display/diagnostics.ml

+ 17 - 4
src/compiler/server.ml

@@ -32,9 +32,22 @@ let s_version =
 	let build = Option.map_default (fun (_,build) -> "+" ^ build) "" Version.version_extra in
 	Printf.sprintf "%d.%d.%d%s%s" version_major version_minor version_revision pre build
 
-let maybe_handle_json_out ctx f_otherwise = match ctx.com.json_out with
+let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 	| None ->
-		f_otherwise ()
+		begin match ctx.com.display.dms_kind with
+		| DMDiagnostics global->
+			List.iter (fun msg ->
+				let msg,p,kind = match msg with
+					| CMInfo(msg,p) -> msg,p,DisplayTypes.DiagnosticsSeverity.Information
+					| CMWarning(msg,p) -> msg,p,DisplayTypes.DiagnosticsSeverity.Warning
+					| CMError(msg,p) -> msg,p,DisplayTypes.DiagnosticsSeverity.Error
+				in
+				add_diagnostics_message ctx.com msg p DisplayTypes.DiagnosticsKind.DKCompilerError kind
+			) (List.rev ctx.messages);
+			raise (Completion (Diagnostics.print ctx.com global))
+		| _ ->
+			f_otherwise ()
+		end
 	| Some(_,f) ->
 		if ctx.has_error then begin
 			let errors = List.map (fun msg ->
@@ -53,7 +66,7 @@ let maybe_handle_json_out ctx f_otherwise = match ctx.com.json_out with
 		end
 
 let default_flush ctx =
-	maybe_handle_json_out ctx (fun () ->
+	check_display_flush ctx (fun () ->
 		List.iter
 			(fun msg -> match msg with
 				| CMInfo _ -> print_endline (compiler_message_string msg)
@@ -404,7 +417,7 @@ let rec wait_loop process_params verbose accept =
 			ctx.flush <- (fun() ->
 				incr compilation_step;
 				compilation_mark := !mark_loop;
-				maybe_handle_json_out ctx (fun () ->
+				check_display_flush ctx (fun () ->
 					List.iter
 						(fun msg ->
 							let s = compiler_message_string msg in

+ 6 - 4
src/context/display/diagnostics.ml

@@ -158,7 +158,7 @@ module Printer = struct
 				Hashtbl.add diag p (dk,p,sev,args)
 		in
 		let add dk p sev args =
-			if global || DisplayPosition.is_display_file p.pfile then add dk p sev args
+			if global || p = null_pos || DisplayPosition.is_display_file p.pfile then add dk p sev args
 		in
 		List.iter (fun (s,p,suggestions) ->
 			let suggestions = ExtList.List.filter_map (fun (s,item,r) ->
@@ -207,7 +207,9 @@ module Printer = struct
 		string_of_json js
 end
 
-let run com global =
+let print com global =
 	let dctx = prepare com global in
-	(* Option.may (fun cs -> CompilationServer.cache_context cs com) (CompilationServer.get()); *)
-	DisplayException.raise_diagnostics (Printer.print_diagnostics dctx com global)
+	Printer.print_diagnostics dctx com global
+
+let run com global =
+	DisplayException.raise_diagnostics (print com global)