From 904ea7aabce1d287fa022f5d3751eb8198af183c Mon Sep 17 00:00:00 2001
From: Michele Alberti <michele.alberti@cea.fr>
Date: Thu, 19 Dec 2019 15:12:17 +0100
Subject: [PATCH] [Server] Implement proposed API for get/set/exec files.
---
src/plugins/server/kernel_ast.ml | 35 ++++++++++++++++++++++++++++
src/plugins/server/kernel_project.ml | 15 ++++++------
src/plugins/server/main.ml | 27 +++++++++++++++++++--
3 files changed, 67 insertions(+), 10 deletions(-)
diff --git a/src/plugins/server/kernel_ast.ml b/src/plugins/server/kernel_ast.ml
index 9001f346b63..963b6f60eea 100644
--- a/src/plugins/server/kernel_ast.ml
+++ b/src/plugins/server/kernel_ast.ml
@@ -164,3 +164,38 @@ let () = Request.register ~page
(fun kf -> Jbuffer.to_json PP.pp_global (Kernel_function.get_global kf))
(* -------------------------------------------------------------------------- *)
+(* --- Files --- *)
+(* -------------------------------------------------------------------------- *)
+
+let () =
+ Request.register
+ ~page
+ ~descr:(Md.plain "Get the currently analyzed source file names")
+ ~kind:`GET
+ ~name:"kernel.ast.getFiles"
+ ~input:(module Junit) ~output:(module Jstring.Jlist)
+ Kernel.Files.get
+
+let () =
+ Request.register
+ ~page
+ ~descr:(Md.plain "Set the source file names to analyze.")
+ ~kind:`SET
+ ~name:"kernel.ast.setFiles"
+ ~input:(module Jstring.Jlist)
+ ~output:(module Junit)
+ Kernel.Files.set
+
+let () =
+ Request.register
+ ~page
+ ~descr:(Md.plain "Compute the AST of the currently set source file names.")
+ ~kind:`EXEC
+ ~name:"kernel.ast.execCompute"
+ ~input:(module Junit)
+ ~output:(module Junit)
+ (fun () ->
+ if not (Ast.is_computed ())
+ then File.init_from_cmdline ())
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/kernel_project.ml b/src/plugins/server/kernel_project.ml
index 532a7b34f77..f992e0c9a2f 100644
--- a/src/plugins/server/kernel_project.ml
+++ b/src/plugins/server/kernel_project.ml
@@ -126,13 +126,12 @@ let () = Request.register ~page
let () =
Request.register
- ~kind:`GET
- ~page ~name:"kernel.project.getSourceFileNames"
- ~descr:(Md.plain "Get the source file names of the current project")
- ~input:(module Junit) ~output:(module Jstring.Jlist)
- (fun () ->
- List.map
- (fun fname -> (Filepath.Normalized.of_string fname :> string))
- (Kernel.Files.get ()))
+ ~page
+ ~descr:(Md.plain "Create a new project")
+ ~kind:`SET
+ ~name:"kernel.project.setCreate"
+ ~input:(module Jstring)
+ ~output:(module ProjectInfo)
+ Project.create
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/main.ml b/src/plugins/server/main.ml
index c00a228cf41..9d0e1f4dff6 100644
--- a/src/plugins/server/main.ml
+++ b/src/plugins/server/main.ml
@@ -147,10 +147,33 @@ let execute exec : _ response =
exec.request (Cmdline.protect exn) ;
`Error(exec.id,Printexc.to_string exn)
+let acceptable_between_yield = 0.25 (* seconds *)
+
let execute_with_yield yield exec =
let db = !Db.progress in
- Db.progress := if exec.yield then yield else no_yield ;
- Extlib.try_finally ~finally:(fun () -> Db.progress := db) execute exec
+ let yield, check =
+ if Senv.debug_atleast 1 then
+ let time = ref (Unix.gettimeofday ()) in
+ let check () =
+ let time' = Unix.gettimeofday () in
+ let diff = time' -. !time in
+ if diff > acceptable_between_yield
+ then
+ Senv.debug
+ "Db.progress missing during %s request (spent %fs between calls)"
+ exec.request
+ diff
+ in
+ (fun () ->
+ check ();
+ yield ();
+ time := Unix.gettimeofday ()),
+ check
+ else
+ yield, ignore
+ in
+ Db.progress := if exec.yield then yield else no_yield;
+ Extlib.try_finally ~finally:(fun () -> Db.progress := db; check ()) execute exec
let execute_debug pp yield exec =
if Senv.debug_atleast 1 then
--
GitLab