Merge remote branch 'origin/master' into edge

(no-precommit-check no-tn-check)

Author: mergerepo

source/ada/lsp-ada_driver.adb

@@ -175,6 +175,7 @@ procedure LSP.Ada_Driver is
                      (VSS.Standard_Paths.Home_Location)
               else ALS_Home)));
    ALS_Dir                : constant Virtual_File := Home_Dir / ".als";
+   Clean_ALS_Dir          : Boolean := False;
    GNATdebug              : constant Virtual_File := Create_From_Base
      (".gnatdebug");
 
@@ -248,6 +249,8 @@ begin
       Parse_Config_File (GNATdebug);
 
    elsif ALS_Dir.Is_Directory then
+      Clean_ALS_Dir := True;
+
       --  Search for custom traces config in traces.cfg
       Parse_Config_File (+Virtual_File'(ALS_Dir / "traces.cfg").Full_Name);
 
@@ -345,7 +348,11 @@ begin
       end;
    end if;
 
+   Ada_Handler.Stop_File_Monitoring;
    Server.Finalize;
+   if Clean_ALS_Dir then
+      Ada_Handler.Clean_Logs (ALS_Dir);
+   end if;
    Ada_Handler.Cleanup;
 
    --  Clean secondary stack up

source/ada/lsp-ada_handlers.adb

@@ -522,17 +522,24 @@ package body LSP.Ada_Handlers is
       Self.Total_Files_Indexed := 0;
    end Release_Contexts_And_Project_Info;
 
+   --------------------------
+   -- Stop_File_Monitoring --
+   --------------------------
+
+   procedure Stop_File_Monitoring (Self : access Message_Handler) is
+   begin
+      if Self.File_Monitor.Assigned then
+         Self.File_Monitor.Stop_Monitoring_Directories;
+      end if;
+   end Stop_File_Monitoring;
+
    -------------
    -- Cleanup --
    -------------
 
    procedure Cleanup (Self : access Message_Handler)
    is
    begin
-      if Self.File_Monitor.Assigned then
-         Self.File_Monitor.Stop_Monitoring_Directories;
-      end if;
-
       --  Cleanup documents
       for Document of Self.Open_Documents loop
          Free (Document);
@@ -546,6 +553,30 @@ package body LSP.Ada_Handlers is
       LSP.File_Monitors.Unchecked_Free (Self.File_Monitor);
    end Cleanup;
 
+   ----------------
+   -- Clean_Logs --
+   ----------------
+
+   procedure Clean_Logs (Self : access Message_Handler; Dir : Virtual_File) is
+      Files : File_Array_Access := Read_Dir (Dir, Files_Only);
+      Dummy : Boolean;
+      Cpt   : Integer := 0;
+   begin
+      Sort (Files.all);
+      --  Browse the log files in reverse timestamp order
+      for F of reverse Files.all loop
+         --  Filter out files like traces.cfg
+         if GNATCOLL.Utils.Ends_With (+F.Base_Name, ".log") then
+            Cpt := Cpt + 1;
+            --  Delete the old logs
+            if Cpt > Self.Log_Threshold then
+               Delete (F, Dummy);
+            end if;
+         end if;
+      end loop;
+      Unchecked_Free (Files);
+   end Clean_Logs;
+
    -----------------------
    -- Exit_Notification --
    -----------------------
@@ -4165,6 +4196,8 @@ package body LSP.Ada_Handlers is
         "documentationStyle";
       useCompletionSnippets             : constant String :=
         "useCompletionSnippets";
+      logThreshold                      : constant String :=
+        "logThreshold";
 
       Ada       : constant LSP.Types.LSP_Any := Value.settings.Get ("ada");
       File      : VSS.Strings.Virtual_String;
@@ -4243,6 +4276,10 @@ package body LSP.Ada_Handlers is
             Self.Named_Notation_Threshold := Ada.Get (namedNotationThreshold);
          end if;
 
+         if Ada.Has_Field (logThreshold) then
+            Self.Log_Threshold := Ada.Get (logThreshold);
+         end if;
+
          --  Check the 'useCompletionSnippets' flag to see if we should use
          --  snippets in completion (if the client supports it).
          if not Self.Completion_Snippets_Enabled then

source/ada/lsp-ada_handlers.ads

@@ -61,9 +61,14 @@ package LSP.Ada_Handlers is
    --  This procedure will be called when an unexpected error is raised in the
    --  request processing loop.
 
+   procedure Stop_File_Monitoring (Self : access Message_Handler);
+
    procedure Cleanup (Self : access Message_Handler);
    --  Free memory referenced by Self
 
+   procedure Clean_Logs (Self : access Message_Handler; Dir : Virtual_File);
+   --  Remove the oldest logs in Dir
+
    subtype Context_Access is LSP.Ada_Context_Sets.Context_Access;
 
    function From_File
@@ -332,6 +337,10 @@ private
       File_Monitor    : LSP.File_Monitors.File_Monitor_Access;
       --  Filesystem monitoring
 
+      Log_Threshold : Natural := 10;
+      --  Maximum number of logs (should be > to the number of servers run
+      --  simultaneously)
+
       ---------------------------------------
       --  Experimental Client Capabilities --
       ---------------------------------------

testsuite/leaks.supp

@@ -22,6 +22,31 @@
    fun:gpr__err__error_msg
 }
 
+### T114-020 leaks with extending project and custom renaming
+{
+   GPR leak
+   Memcheck:Leak
+   match-leak-kinds: definite
+   fun:malloc
+   fun:gnatcoll__memory__alloc
+   fun:system__pool_global__allocate
+   fun:gpr__nmsc__add_source
+   fun:gpr__nmsc__check_file
+   fun:gpr__nmsc__search_directories
+   fun:gpr__nmsc__find_sources
+   fun:gpr__nmsc__look_for_sources
+   fun:gpr__nmsc__process_naming_scheme__check
+   fun:gpr__nmsc__process_naming_scheme__recursive_check.71.isra.0
+   fun:gpr__nmsc__process_naming_scheme__check_all_projects__recursive_check_context__recursive_check.68
+   fun:gpr__nmsc__process_naming_scheme__check_all_projects__recursive_check_context__recursive_check.68
+   fun:gpr__nmsc__process_naming_scheme__check_all_projects__recursive_check_context__recursive_check.68
+   fun:gpr__nmsc__process_naming_scheme__check_all_projects__recursive_check_context.67.constprop.0
+   fun:gpr__nmsc__process_naming_scheme__check_all_projects
+   fun:gpr__nmsc__process_naming_scheme
+   fun:gpr__proc__check
+   fun:gpr__proc__process_project_tree_phase_2
+}
+
 ### SC20-039 leaks when loading library aggregate projects
 {
    <insert_a_suppression_name_here>
@@ -44,22 +69,6 @@
    fun:gpr__proc__recursive_process__process_aggregated_projects
 }
 
-### T114-020 leaks with extending project and custom renaming
-{
-   <insert_a_suppression_name_here>
-   Memcheck:Leak
-   match-leak-kinds: definite
-   fun:malloc
-   fun:__gnat_malloc
-   fun:system__pool_global__allocate
-   fun:gpr__nmsc__add_source
-   fun:gpr__nmsc__check_file
-   fun:gpr__nmsc__search_directories__2
-   fun:gpr__nmsc__find_sources
-   fun:gpr__nmsc__look_for_sources
-   fun:gpr__nmsc__process_naming_scheme__check
-}
-
 # Valgrind limitation: GNAT’s superaligned secondary stack chunk
 # appears to be leaked, but we actually have a pointer to the
 # middle of the allocated memory block.