Workspace-specific diagnostics for project issues

A new kind of diagnostics' source has been introduced for that.

These diagnostics are published on the root directory's URI instead
on files being opened.

For eng/ide/ada_language_server#1524

Author: AnthonyLeonardoGracio

source/ada/lsp-ada_context_sets.adb

@@ -23,8 +23,8 @@ with LSP.Ada_File_Sets;
 
 package body LSP.Ada_Context_Sets is
 
-   procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-     (LSP.Ada_Contexts.Context, Context_Access);
+   procedure Unchecked_Free is new
+     Ada.Unchecked_Deallocation (LSP.Ada_Contexts.Context, Context_Access);
 
    -------------
    -- Cleanup --

source/ada/lsp-ada_context_sets.ads

@@ -34,19 +34,17 @@ package LSP.Ada_Context_Sets is
 
    type Context_Access is access LSP.Ada_Contexts.Context;
 
-   package Context_Lists is new Ada.Containers.Doubly_Linked_Lists
-     (Context_Access);
+   package Context_Lists is new
+     Ada.Containers.Doubly_Linked_Lists (Context_Access);
 
    function Is_Empty (Self : Context_Set'Class) return Boolean;
    --  Check if the set has no contexts
 
-   procedure Prepend
-     (Self : in out Context_Set'Class;
-      Item : Context_Access);
+   procedure Prepend (Self : in out Context_Set'Class; Item : Context_Access);
    --  Append an item to the set
 
    procedure Reload_All_Contexts (Self : in out Context_Set'Class);
-   --  Reload ech context in the set
+   --  Reload each context in the set
 
    function Get_Best_Context
      (Self : Context_Set'Class;
@@ -97,9 +95,12 @@ private
       "="             => "=");
 
    type Context_Set is tagged limited record
-      Contexts : Context_Lists.List;
-      Map      : Maps.Map;  --  A map from Context.Id to Context access
-      Total    : Natural := 0;
+      Contexts           : Context_Lists.List;
+
+      Map                : Maps.Map;
+      --  A map from Context.Id to Context access
+
+      Total              : Natural := 0;
    end record;
 
 end LSP.Ada_Context_Sets;

source/ada/lsp-ada_contexts.ads

@@ -85,8 +85,7 @@ package LSP.Ada_Contexts is
    --  context after calling this.
 
    function URI_To_File
-     (Self : Context;
-      URI  : LSP.Structures.DocumentUri)
+     (Self : Context; URI : LSP.Structures.DocumentUri)
       return GNATCOLL.VFS.Virtual_File;
 
    procedure Find_All_References

source/ada/lsp-ada_documents.adb

@@ -1132,18 +1132,16 @@ package body LSP.Ada_Documents is
    ----------------
 
    procedure Initialize
-     (Self       : in out Document;
-      URI        : LSP.Structures.DocumentUri;
-      Text       : VSS.Strings.Virtual_String;
-      Diagnostic : LSP.Diagnostic_Sources.Diagnostic_Source_Access) is
+     (Self : in out Document;
+      URI  : LSP.Structures.DocumentUri;
+      Text : VSS.Strings.Virtual_String) is
    begin
       LSP.Text_Documents.Constructors.Initialize (Self, URI, Text);
 
-      Self.Refresh_Symbol_Cache   := True;
-      Self.Diagnostic_Sources (1) := new
-        LSP.Ada_Documents.LAL_Diagnostics.Diagnostic_Source
-          (Self'Unchecked_Access);
-      Self.Diagnostic_Sources (2)  := Diagnostic;
+      Self.Refresh_Symbol_Cache := True;
+      Self.Diagnostic_Sources.Append
+        (new LSP.Ada_Documents.LAL_Diagnostics.Diagnostic_Source
+               (Self'Unchecked_Access));
    end Initialize;
 
    ----------------------

source/ada/lsp-ada_documents.ads

@@ -33,7 +33,7 @@ limited with LSP.Ada_Contexts;
 limited with LSP.Ada_Handlers;
 with LSP.Ada_Completions;
 with LSP.Constants;
-with LSP.Diagnostic_Sources;
+with LSP.Diagnostic_Sources; use LSP.Diagnostic_Sources;
 with LSP.Text_Documents.Langkit_Documents;
 with LSP.Search;
 with LSP.Structures;
@@ -52,12 +52,10 @@ package LSP.Ada_Documents is
      with Storage_Size => 0;
 
    procedure Initialize
-     (Self       : in out Document;
-      URI        : LSP.Structures.DocumentUri;
-      Text       : VSS.Strings.Virtual_String;
-      Diagnostic : LSP.Diagnostic_Sources.Diagnostic_Source_Access);
-   --  Create a new document from a TextDocumentItem. Use Diagnostic as
-   --  project status diagnostic source.
+     (Self : in out Document;
+      URI  : LSP.Structures.DocumentUri;
+      Text : VSS.Strings.Virtual_String);
+   --  Create a new document from a TextDocumentItem.
 
    procedure Cleanup (Self : in out Document);
    --  Free all the data associated to this document.
@@ -306,16 +304,13 @@ private
       "<"          => VSS.Strings."<",
       "="          => Name_Vectors."=");
 
-   type Diagnostic_Source_Array is array (Natural range <>) of
-     LSP.Diagnostic_Sources.Diagnostic_Source_Access;
-
    type Document (Tracer : not null LSP.Tracers.Tracer_Access) is
      new LSP.Text_Documents.Langkit_Documents.Langkit_Text_Document with record
       Symbol_Cache : Symbol_Maps.Map;
       --  Cache of all defining name symbol of the document.
       Refresh_Symbol_Cache : Boolean := False;
       --  Symbol_Cache rebuild is required before.
-      Diagnostic_Sources : Diagnostic_Source_Array (1 .. 2);
+      Diagnostic_Sources : Diagnostic_Source_Vectors.Vector;
       --  Known sources of diagnostics
    end record;
 

source/ada/lsp-ada_driver.adb

@@ -564,9 +564,9 @@ begin
    Gnatformat.Configuration.Elaborate_GPR2;
 
    declare
-      Allow_Incremental_Text_Changes : constant GNATCOLL.Traces.Trace_Handle
-        := GNATCOLL.Traces.Create ("ALS.ALLOW_INCREMENTAL_TEXT_CHANGES",
-                                   GNATCOLL.Traces.On);
+      Allow_Incremental_Text_Changes : constant GNATCOLL.Traces.Trace_Handle :=
+        GNATCOLL.Traces.Create
+          ("ALS.ALLOW_INCREMENTAL_TEXT_CHANGES", GNATCOLL.Traces.On);
       --  Trace to activate the support for incremental text changes.
 
       CLI_Config_Path : constant VSS.Strings.Virtual_String :=
@@ -584,7 +584,7 @@ begin
    begin
       Ada_Handler.Initialize
         (Incremental_Text_Changes => Allow_Incremental_Text_Changes.Is_Active,
-         CLI_Config_File => CLI_Config_File);
+         CLI_Config_File          => CLI_Config_File);
    end;
 
    Server.Initialize (Stream'Unchecked_Access);

source/ada/lsp-ada_handlers-project_diagnostics.adb

@@ -24,14 +24,14 @@ package body LSP.Ada_Handlers.Project_Diagnostics is
    --  repeat the information every time diagnostics are published for every
    --  file.
 
-   --------------------
-   -- Get_Diagnostic --
-   --------------------
+   ---------------------
+   -- Get_Diagnostics --
+   ---------------------
 
-   overriding procedure Get_Diagnostic
-     (Self    : in out Diagnostic_Source;
-      Context : LSP.Ada_Contexts.Context;
-      Errors  : out LSP.Structures.Diagnostic_Vector) is
+   overriding
+   procedure Get_Diagnostics
+     (Self        : in out Diagnostic_Source;
+      Diagnostics : out LSP.Structures.Diagnostic_Vector) is
    begin
       if Self.Handler.Configuration.Project_Diagnostics_Enabled then
          Self.Last_Status := Self.Handler.Project_Status;
@@ -42,21 +42,18 @@ package body LSP.Ada_Handlers.Project_Diagnostics is
          --  diagnostics only if there is an issue to solve or a potential
          --  enhancement.
 
-         Errors.Append_Vector
+         Diagnostics.Append_Vector
            (LSP.Ada_Project_Loading.Get_Diagnostics (Self.Last_Status));
       end if;
-   end Get_Diagnostic;
+   end Get_Diagnostics;
 
    ------------------------
    -- Has_New_Diagnostic --
    ------------------------
 
    overriding function Has_New_Diagnostic
-     (Self    : in out Diagnostic_Source;
-      Context : LSP.Ada_Contexts.Context)
-      return Boolean
-   is
-      pragma Unreferenced (Context);
+     (Self    : in out Diagnostic_Source)
+      return Boolean is
    begin
       if Self.Handler.Configuration.Project_Diagnostics_Enabled then
          return LSP.Ada_Project_Loading.Has_New_Diagnostics

source/ada/lsp-ada_handlers-project_diagnostics.ads

@@ -15,31 +15,29 @@
 -- of the license.                                                          --
 ------------------------------------------------------------------------------
 
-with LSP.Ada_Contexts;
 with LSP.Ada_Project_Loading;
 with LSP.Diagnostic_Sources;
 
 package LSP.Ada_Handlers.Project_Diagnostics is
 
    type Diagnostic_Source
-     (Handler : not null access LSP.Ada_Handlers.Message_Handler)
-   is limited new LSP.Diagnostic_Sources.Diagnostic_Source with private;
+     (Handler : not null access LSP.Ada_Handlers.Message_Handler'Class)
+   is limited new LSP.Diagnostic_Sources.Workspace_Diagnostic_Source with private;
 
-   overriding procedure Get_Diagnostic
-     (Self    : in out Diagnostic_Source;
-      Context : LSP.Ada_Contexts.Context;
-      Errors  : out LSP.Structures.Diagnostic_Vector);
+   overriding
+   procedure Get_Diagnostics
+     (Self        : in out Diagnostic_Source;
+      Diagnostics : out LSP.Structures.Diagnostic_Vector);
    --  Fill diagnostics for given document.
 
    overriding function Has_New_Diagnostic
-     (Self    : in out Diagnostic_Source;
-      Context : LSP.Ada_Contexts.Context) return Boolean;
+     (Self    : in out Diagnostic_Source) return Boolean;
 
 private
 
    type Diagnostic_Source
-     (Handler : not null access LSP.Ada_Handlers.Message_Handler)
-   is limited new LSP.Diagnostic_Sources.Diagnostic_Source with record
+     (Handler : not null access LSP.Ada_Handlers.Message_Handler'Class)
+   is limited new LSP.Diagnostic_Sources.Workspace_Diagnostic_Source with record
       Last_Status : LSP.Ada_Project_Loading.Project_Status_Type;
    end record;
 

source/ada/lsp-ada_handlers-project_loading.adb

@@ -168,23 +168,26 @@ package body LSP.Ada_Handlers.Project_Loading is
          Tracer.Trace_Text ("Found ada.projectFile = " & Project_File);
 
          if Project_File.Starts_With ("file://") then
-            Project_File := VSS.Strings.Conversions.To_Virtual_String
-            (URIs.Conversions.To_File
-               (VSS.Strings.Conversions.To_UTF_8_String (Project_File), True));
+            Project_File :=
+              VSS.Strings.Conversions.To_Virtual_String
+                (URIs.Conversions.To_File
+                   (VSS.Strings.Conversions.To_UTF_8_String (Project_File),
+                    True));
          end if;
 
          --  Report how we found the project
-         Self.Project_Status.Set_Project_Type (LSP.Ada_Project_Loading.Configured_Project);
+         Self.Project_Status.Set_Project_Type
+           (LSP.Ada_Project_Loading.Configured_Project);
 
       elsif Is_Alire_Crate then
          Tracer.Trace ("Workspace is an Alire crate");
          Tracer.Trace ("Determining project from 'alr show' output");
 
          LSP.Alire.Determine_Alire_Project
-           (Root        => Self.Client.Root_Directory.Display_Full_Name,
-            Has_Alire   => Has_Alire,
-            Error       => Alire_Errors,
-            Project     => Project_File);
+           (Root      => Self.Client.Root_Directory.Display_Full_Name,
+            Has_Alire => Has_Alire,
+            Error     => Alire_Errors,
+            Project   => Project_File);
 
          if not Has_Alire then
             Tracer.Trace
@@ -196,7 +199,8 @@ package body LSP.Ada_Handlers.Project_Loading is
             Tracer.Trace_Text ("Encountered errors: " & Alire_Errors);
          else
             --  Report how we found the project
-            Self.Project_Status.Set_Project_Type (LSP.Ada_Project_Loading.Alire_Project);
+            Self.Project_Status.Set_Project_Type
+              (LSP.Ada_Project_Loading.Alire_Project);
          end if;
       end if;
 
@@ -205,7 +209,7 @@ package body LSP.Ada_Handlers.Project_Loading is
          Tracer.Trace ("Looking for a unique project at the root");
          declare
             Files : GNATCOLL.VFS.File_Array_Access :=
-               Self.Client.Root_Directory.Read_Dir (GNATCOLL.VFS.Files_Only);
+              Self.Client.Root_Directory.Read_Dir (GNATCOLL.VFS.Files_Only);
             Found : GNATCOLL.VFS.Virtual_File;
          begin
             for X of Files.all loop
@@ -222,24 +226,32 @@ package body LSP.Ada_Handlers.Project_Loading is
                Project_File := LSP.Utils.To_Virtual_String (Found);
 
                --  Report how we found the project
-               Self.Project_Status.Set_Project_Type (LSP.Ada_Project_Loading.Single_Project_Found);
+               Self.Project_Status.Set_Project_Type
+                 (LSP.Ada_Project_Loading.Single_Project_Found);
 
                Tracer.Trace_Text ("Found unique project: " & Project_File);
             else
-               Tracer.Trace ("Found " & GPRs_Found'Image & " projects at the root");
+               Tracer.Trace
+                 ("Found " & GPRs_Found'Image & " projects at the root");
             end if;
          end;
       end if;
 
       --  At this stage we tried everything to find a project file. Now let's try to load.
       if not Project_File.Is_Empty then
          declare
-            Environment : GPR2.Environment.Object := GPR2.Environment.Process_Environment;
+            Environment : GPR2.Environment.Object :=
+              GPR2.Environment.Process_Environment;
 
             Charset : constant VSS.Strings.Virtual_String :=
-              (if not Self.Configuration.Charset.Is_Empty then Self.Configuration.Charset
-               elsif Is_Alire_Crate then VSS.Strings.Virtual_String'("utf-8")  --  Alire projects tend to prefer utf-8
-               else "iso-8859-1");
+              (if not Self.Configuration.Charset.Is_Empty
+               then Self.Configuration.Charset
+               elsif Is_Alire_Crate
+               then
+                 VSS.Strings.Virtual_String'
+                   ("utf-8")  --  Alire projects tend to prefer utf-8
+               else
+                 "iso-8859-1");
 
             Errors : VSS.Strings.Virtual_String;
          begin
@@ -248,16 +260,19 @@ package body LSP.Ada_Handlers.Project_Loading is
                   Tracer.Trace ("Setting environment from 'alr printenv'");
 
                   LSP.Alire.Setup_Alire_Env
-                    (Root        => Self.Client.Root_Directory.Display_Full_Name,
+                    (Root        =>
+                       Self.Client.Root_Directory.Display_Full_Name,
                      Has_Alire   => Has_Alire,
                      Error       => Errors,
                      Environment => Environment);
 
                   if not Errors.Is_Empty then
-                     Tracer.Trace_Text ("Encountered errors with Alire:" & LF & Errors);
+                     Tracer.Trace_Text
+                       ("Encountered errors with Alire:" & LF & Errors);
                   end if;
                else
-                  Tracer.Trace ("Alire environment is already set up. Not calling 'alr printenv'.");
+                  Tracer.Trace
+                    ("Alire environment is already set up. Not calling 'alr printenv'.");
                end if;
             end if;
 
@@ -277,14 +292,19 @@ package body LSP.Ada_Handlers.Project_Loading is
          Load_Implicit_Project
            (Self,
             (if GPRs_Found = 0 then LSP.Ada_Project_Loading.No_Project
-             elsif GPRs_Found > 1 then LSP.Ada_Project_Loading.Multiple_Projects
+             elsif GPRs_Found > 1
+             then LSP.Ada_Project_Loading.Multiple_Projects
              else LSP.Ada_Project_Loading.Project_Not_Found));
       end if;
 
       --  By this point we must have a context: either a project was
       --  successfully loaded, or project loading failed and we created a dummy
       --  context to avoid retrying.
       pragma Assert (not Self.Contexts.Is_Empty);
+
+      --  Publish workspace diagnostics every time a project might have
+      --  been loaded/reloaded.
+      Self.Publish_Diagnostics (Force => True);
    end Ensure_Project_Loaded;
 
    ---------------------