Configurable cache retention time

Remove old call to `flush_caches`

Add `-cache-time` flag

Add tests for `--cache-time` flag

Add changelog entry for ocaml#1698

Change cache time measure to minutes.

Fix quoting.t

Fix cache-time.t tests

Replace awk with sed in cache-time.t

debug logs

Fix grep pattern

Investigate logs

Flush file_cache logs

Investigate logs

Move test file

Add

CHANGES.md

@@ -3,6 +3,7 @@ merlin NEXT_VERSION
 
   + merlin binary
     - Fix a follow-up issue to the preference of non-ghost nodes introduced in #1660 (#1690, fixes #1689)
+    - Add `--cache-time` flag, that sets cache invalidation period. (#1698)
   + editor modes
     - vim: load merlin when Vim is compiled with +python3/dyn (e.g. MacVim)
 

doc/dev/CACHING.md

@@ -77,7 +77,8 @@ to be used anymore.
 
 `Mocaml.flush_caches` remove all files that have changed on disk or that
 haven't been used for some time.  By default, `ocamlmerlin_server` remove
-entries that haven't been used in the last 300 seconds.
+entries that haven't been used in the last 5 minutes. This behavior can be
+changed with `--cache-time` flag.
 
 Since this involve stating each entry, the check is done after answering.
 

src/frontend/ocamlmerlin/new/new_merlin.ml

@@ -91,6 +91,8 @@ let run = function
         (* Start processing query *)
         Logger.with_log_file Mconfig.(config.merlin.log_file)
           ~sections:Mconfig.(config.merlin.log_sections) @@ fun () ->
+        Mocaml.flush_caches
+          ~older_than:(float_of_int (60 * Mconfig.(config.merlin.cache_time))) ();
         File_id.with_cache @@ fun () ->
         let source = Msource.make (Misc.string_of_file stdin) in
         let pipeline = Mpipeline.make config source in

src/frontend/ocamlmerlin/ocamlmerlin_server.ml

@@ -33,7 +33,6 @@ module Server = struct
 
   let server_accept merlinid server =
     let rec loop total =
-      Mocaml.flush_caches ~older_than:300.0 ();
       let merlinid' = File_id.get Sys.executable_name in
       if total > merlin_timeout ||
          not (File_id.check merlinid merlinid') then

src/kernel/mconfig.ml

@@ -92,8 +92,9 @@ type merlin = {
   flags_applied : string list with_workdir list;
 
   failures : string list;
-  extension_to_reader : (string * string) list
+  extension_to_reader : (string * string) list;
 
+  cache_time : int
 }
 
 let dump_merlin x =
@@ -129,7 +130,8 @@ let dump_merlin x =
           "extension", `String suffix;
           "reader", `String reader;
         ]) x.extension_to_reader
-    )
+    );
+    "cache_time"   , Json.string (string_of_int x.cache_time)
   ]
 
 module Verbosity = struct
@@ -358,6 +360,15 @@ let merlin_flags = [
     marg_path (fun path merlin -> {merlin with stdlib = Some path}),
     "<path> Change path of ocaml standard library"
   );
+  (
+    "-cache-time",
+    Marg.param "int" (fun prot merlin ->
+        try {merlin with cache_time = (int_of_string prot)}
+        with _ -> invalid_arg "Valid value is int";
+      ),
+    "Change file cache retention time. It's measured in minutes. \
+      Default value is 5."
+  );
   (
     (* Legacy support for janestreet. Ignored. To be removed soon. *)
     "-attributes-allowed",
@@ -627,6 +638,7 @@ let initial = {
 
     failures = [];
     extension_to_reader = [(".re","reason");(".rei","reason")];
+    cache_time = 5;
   };
   query = {
     filename = "*buffer*";

src/kernel/mconfig.mli

@@ -49,7 +49,8 @@ type merlin = {
   flags_applied : string list with_workdir list;
 
   failures : string list;
-  extension_to_reader : (string * string) list
+  extension_to_reader : (string * string) list;
+  cache_time : int
 }
 
 val dump_merlin : merlin -> json

tests/test-dirs/config/dot-merlin-reader/quoting.t

@@ -66,7 +66,8 @@
         "extension": ".rei",
         "reader": "reason"
       }
-    ]
+    ],
+    "cache_time": "5"
   }
 
   $ rm .merlin

tests/test-dirs/server-tests/cache-time.t

@@ -0,0 +1,37 @@
+  $ $MERLIN server stop-server
+
+  $ cat >dune-project <<EOF
+  > (lang dune 2.0)
+  > EOF
+
+  $ cat >dune <<EOF
+  > 
+  > (executable
+  >  (name main)
+  >  (modules main)
+  > EOF
+
+  $ cat > main.ml <<EOF
+  > let () = print_int 0
+  > EOF
+
+Let's populate file cache
+  $ $MERLIN server errors -log-file merlin_logs -cache-time 45 \
+  > -filename main.ml 1> /dev/null <main.ml
+
+When cache time is set to large value, we keep the cache
+  $ $MERLIN server errors -log-file merlin_logs -cache-time 45 \
+  > -filename main.ml 1> /dev/null <main.ml
+  $ cat merlin_logs | grep -A1 "File_cache(Cmi_cache) - flush" \
+  > | tail -1 | sed 's/\ ".*\"//'
+  keeping
+
+When cache time is set to 0, file cache gets flushed
+  $ $MERLIN server errors -log-file merlin_logs -cache-time 0 \
+  > -filename main.ml 1> /dev/null <main.ml
+  $ cat merlin_logs | grep -A1 "File_cache(Cmi_cache) - flush" \
+  > | tail -1 | sed 's/\ ".*\"//'
+  removing
+
+Stop server
+  $ $MERLIN server stop-server