Merge branch 'topic/#1564' into 'master'

Display diagnostics on the project file when possible

See merge request eng/ide/ada_language_server!1892

Author: AnthonyLeonardoGracio

source/ada/lsp-ada_handlers-project_diagnostics.adb

@@ -30,20 +30,37 @@ package body LSP.Ada_Handlers.Project_Diagnostics is
 
    overriding
    procedure Get_Diagnostics
-     (Self        : in out Diagnostic_Source;
-      Diagnostics : out LSP.Structures.Diagnostic_Vector) is
+     (Self          : in out Diagnostic_Source;
+      Diagnostics   : out LSP.Structures.Diagnostic_Vector;
+      Target_File   : out GNATCOLL.VFS.Virtual_File)
+   is
+      use GNATCOLL.VFS;
    begin
       if Self.Handler.Configuration.Project_Diagnostics_Enabled then
-         Self.Last_Status := Self.Handler.Project_Status;
+         declare
+            Project_File : constant Virtual_File :=
+              Self.Handler.Project_Status.Get_Project_File;
+            Root_Dir     : constant Virtual_File :=
+              Self.Handler.Client.Root_Directory;
+         begin
+            --  Set the target file according to the source's initial target
+            --  (root directory or project file itself)
+            Target_File :=
+              (if Project_File.Is_Regular_File then Project_File
+               else Root_Dir);
 
-         Tracer.Trace ("Project loading status: " & Self.Last_Status'Image);
+            Self.Last_Status := Self.Handler.Project_Status;
 
-         --  If we have a valid project return immediately: we want to display
-         --  diagnostics only if there is an issue to solve or a potential
-         --  enhancement.
+            Tracer.Trace ("Project loading status: " & Self.Last_Status'Image);
+
+            --  If we have a valid project return immediately: we want to display
+            --  diagnostics only if there is an issue to solve or a potential
+            --  enhancement.
+
+            Diagnostics.Append_Vector
+              (LSP.Ada_Project_Loading.Get_Diagnostics (Self.Last_Status));
+         end;
 
-         Diagnostics.Append_Vector
-           (LSP.Ada_Project_Loading.Get_Diagnostics (Self.Last_Status));
       end if;
    end Get_Diagnostics;
 

source/ada/lsp-ada_handlers-project_diagnostics.ads

@@ -15,23 +15,25 @@
 -- of the license.                                                          --
 ------------------------------------------------------------------------------
 
+with GNATCOLL.VFS;
 with LSP.Ada_Project_Loading;
 with LSP.Diagnostic_Sources;
 
 package LSP.Ada_Handlers.Project_Diagnostics is
 
    Project_Diagnostics_Source_ID : constant VSS.Strings.Virtual_String :=
      "ada.project";
-
    type Diagnostic_Source
      (Handler : not null access LSP.Ada_Handlers.Message_Handler'Class)
    is limited new LSP.Diagnostic_Sources.Workspace_Diagnostic_Source with private;
 
-   overriding
-   procedure Get_Diagnostics
-     (Self        : in out Diagnostic_Source;
-      Diagnostics : out LSP.Structures.Diagnostic_Vector);
+   overriding procedure Get_Diagnostics
+     (Self          : in out Diagnostic_Source;
+      Diagnostics   : out LSP.Structures.Diagnostic_Vector;
+      Target_File   : out GNATCOLL.VFS.Virtual_File);
    --  Fill diagnostics for given document.
+   --  Target_File is the file where diagnostics should be published
+   --  (e.g: project file, workspace's root directory).
 
    overriding function Has_New_Diagnostic
      (Self    : in out Diagnostic_Source) return Boolean;

source/ada/lsp-ada_handlers.adb

@@ -178,16 +178,6 @@ package body LSP.Ada_Handlers is
      (Self : in out Message_Handler; Context : LSP.Ada_Contexts.Context)
       return Libadalang.Analysis.Analysis_Unit_Array;
 
-   procedure Get_Workspace_Diagnostics
-     (Self    : in out Message_Handler'Class;
-      Changed : out Boolean;
-      Errors  : out LSP.Structures.Diagnostic_Vector;
-      Force   : Boolean := False);
-   --  Get all the worskpace-specific diagnostics, using the handler's workspace
-   --  diagnostics' sources.
-   --  When Force is True, any existing diagnostic will be retrieved, no matter
-   --  if they have changed or not since the last query.
-
    -----------------------------
    -- Allocate_Progress_Token --
    -----------------------------
@@ -391,27 +381,6 @@ package body LSP.Ada_Handlers is
       end if;
    end Get_Open_Document_Version;
 
-   -------------------------------
-   -- Get_Workspace_Diagnostics --
-   -------------------------------
-
-   procedure Get_Workspace_Diagnostics
-     (Self    : in out Message_Handler'Class;
-      Changed : out Boolean;
-      Errors  : out LSP.Structures.Diagnostic_Vector;
-      Force   : Boolean := False) is
-   begin
-      Errors.Clear;
-      Changed := (for some Source of Self.Diagnostic_Sources =>
-                    Source.Has_New_Diagnostic);
-
-      if Changed or else Force then
-         for Source of Self.Diagnostic_Sources loop
-            Source.Get_Diagnostics (Errors);
-         end loop;
-      end if;
-   end Get_Workspace_Diagnostics;
-
    ----------------------------
    -- Imprecise_Resolve_Name --
    ----------------------------
@@ -454,13 +423,12 @@ package body LSP.Ada_Handlers is
      (Self                     : in out Message_Handler;
       Incremental_Text_Changes : Boolean;
       CLI_Config_File          : GNATCOLL.VFS.Virtual_File :=
-        GNATCOLL.VFS.No_File)
-   is
+        GNATCOLL.VFS.No_File) is
    begin
       Self.Incremental_Text_Changes := Incremental_Text_Changes;
       Self.File_Monitor :=
         new LSP.Servers.FS_Watch.FS_Watch_Monitor (Self.Server);
-      Self.Diagnostic_Sources :=
+      Self.Workspace_Diagnostic_Sources :=
         [new LSP.Ada_Handlers.Project_Diagnostics.Diagnostic_Source
            (Self'Unchecked_Access)];
 
@@ -3739,32 +3707,55 @@ package body LSP.Ada_Handlers is
    -------------------------
 
    procedure Publish_Diagnostics
-     (Self              : in out Message_Handler;
-      Other_Diagnostics : LSP.Structures.Diagnostic_Vector :=
-        LSP.Structures.Empty;
-      Force             : Boolean := False)
+     (Self : in out Message_Handler; Force : Boolean := False)
    is
-      Diag    : LSP.Structures.PublishDiagnosticsParams;
-      Changed : Boolean;
+      use GNATCOLL.VFS;
 
+      Diag        : LSP.Structures.PublishDiagnosticsParams;
+      Changed     : Boolean;
+      Target_File : Virtual_File;
    begin
       --  Retrieve all the workspace diagnostics and publish them.
 
       if Self.Configuration.Diagnostics_Enabled then
-         Diag.diagnostics.Append_Vector (Other_Diagnostics);
+         Changed :=
+           (for some Source of Self.Workspace_Diagnostic_Sources
+            => Source.Has_New_Diagnostic);
+
+         if Changed or else Force then
+            --  First clear any currently published workspace diagnostics
+            for File of Self.Workspace_Diagnostic_Files loop
+               Self.Sender.On_PublishDiagnostics_Notification
+                 (LSP.Structures.PublishDiagnosticsParams'
+                    (uri    =>
+                       (VSS.Strings.Conversions.To_Virtual_String
+                          (URIs.Conversions.From_File (File.Display_Full_Name))
+                        with null record),
+                     others => <>));
+            end loop;
 
-         Self.Get_Workspace_Diagnostics
-           (Changed => Changed,
-            Errors  => Diag.diagnostics,
-            Force   => Force);
+            Self.Workspace_Diagnostic_Files.Clear;
 
-         if Changed or else not Other_Diagnostics.Is_Empty then
-            Diag.uri :=
-              (VSS.Strings.Conversions.To_Virtual_String
-                 (URIs.Conversions.From_File
-                    (Self.Client.Root_Directory.Display_Full_Name))
-               with null record);
-            Self.Sender.On_PublishDiagnostics_Notification (Diag);
+            --  Query all the workspace diagnostic sources, and publish
+            --  diagnostics on their target file, if any
+            for Source of Self.Workspace_Diagnostic_Sources loop
+               Source.Get_Diagnostics
+                 (Diagnostics => Diag.diagnostics, Target_File => Target_File);
+
+               --  We have some diagnostics: publish them
+               if not Diag.diagnostics.Is_Empty then
+                  Self.Workspace_Diagnostic_Files.Include (Target_File);
+
+                  Diag.uri :=
+                    (VSS.Strings.Conversions.To_Virtual_String
+                       (URIs.Conversions.From_File
+                          (Target_File.Display_Full_Name))
+                     with null record);
+                  Self.Sender.On_PublishDiagnostics_Notification (Diag);
+
+                  Diag.diagnostics.Clear;
+               end if;
+            end loop;
          end if;
       end if;
    end Publish_Diagnostics;

source/ada/lsp-ada_handlers.ads

@@ -200,9 +200,15 @@ private
       --  is known to the server, this context should map to the implicit
       --  project.
 
-      Diagnostic_Sources : Workspace_Diagnostic_Source_Vectors.Vector;
+      Workspace_Diagnostic_Sources :
+        Workspace_Diagnostic_Source_Vectors.Vector;
       --  Workspace diagnostic sources.
 
+      Workspace_Diagnostic_Files : LSP.Ada_File_Sets.File_Sets.Set;
+      --  Files for which workspace diagnostics have been published.
+      --  Used to clear any existing workspace diagnostic before querying
+      --  new ones.
+
       Highlighter    : aliased LSP.Ada_Highlighters.Ada_Highlighter;
       --  Semantic token highlighter for Ada
 
@@ -400,15 +406,12 @@ private
    --  they have changed or not.
 
    procedure Publish_Diagnostics
-     (Self              : in out Message_Handler;
-      Other_Diagnostics : LSP.Structures.Diagnostic_Vector :=
-        LSP.Structures.Empty;
-      Force             : Boolean := False);
+     (Self : in out Message_Handler; Force : Boolean := False);
    --  Publish workspace diagnostic messages.
-   --  Other_Diagnostics can be used to specify punctual diagnostics not coming
-   --  from sources that analyze files when being opened or modified.
    --  When Force is True, the diagnostics will always be sent, regardless if
    --  they have changed or not.
+   --  Currently published workspace diagnostics are always cleared
+   --  before querying new workspace diagnostics.
 
    overriding function To_File
      (Self : Message_Handler;

source/ada/lsp-diagnostic_sources.ads

@@ -17,6 +17,7 @@
 
 with Ada.Containers.Vectors;
 with Ada.Unchecked_Deallocation;
+with GNATCOLL.VFS;
 with LSP.Structures;
 limited with LSP.Ada_Contexts;
 
@@ -49,8 +50,10 @@ package LSP.Diagnostic_Sources is
      (Diagnostic_Source'Class, Diagnostic_Source_Access);
 
    type Workspace_Diagnostic_Source is limited interface;
-   --  Interface for worspace diagnostics (i.e: diagnostics that
+   --  Interface for workspace diagnostics (i.e: diagnostics that
    --  are not specific to a given context/document).
+   --  Currently published workspace diagnostics are always cleared
+   --  before querying new workspace diagnostics.
 
    type Workspace_Diagnostic_Source_Access is
      access LSP.Diagnostic_Sources.Workspace_Diagnostic_Source'Class;
@@ -61,8 +64,9 @@ package LSP.Diagnostic_Sources is
         LSP.Diagnostic_Sources."=");
 
    procedure Get_Diagnostics
-     (Self        : in out Workspace_Diagnostic_Source;
-      Diagnostics : out LSP.Structures.Diagnostic_Vector)
+     (Self          : in out Workspace_Diagnostic_Source;
+      Diagnostics   : out LSP.Structures.Diagnostic_Vector;
+      Target_File   : out GNATCOLL.VFS.Virtual_File)
    is abstract;
 
    function Has_New_Diagnostic

testsuite/ada_lsp/project_config.missing_file/test.json

@@ -70,7 +70,7 @@
                "jsonrpc": "2.0",
                "method": "textDocument/publishDiagnostics",
                "params": {
-                  "uri": "$URI{}",
+                  "uri": "$URI{prj1.gpr}",
                   "diagnostics": [
                      {
                         "range": {

testsuite/ada_lsp/project_diags.errors_to_errors/test.json

@@ -52,7 +52,7 @@
             {
                "method": "textDocument/publishDiagnostics",
                "params": {
-                  "uri": "$URI{}",
+                  "uri": "$URI{test.gpr}",
                   "diagnostics": [
                        {
                         "range": {
@@ -125,7 +125,7 @@
                "jsonrpc": "2.0",
                "method": "textDocument/publishDiagnostics",
                "params": {
-                  "uri": "$URI{}",
+                  "uri": "$URI{not_visible_project/project_with_errors.gpr}",
                   "diagnostics": [
                        {
                         "range": {

testsuite/ada_lsp/project_diags.errors_to_not_found/test.json

@@ -52,7 +52,7 @@
             {
                "method": "textDocument/publishDiagnostics",
                "params": {
-                  "uri": "$URI{}",
+                  "uri": "$URI{test.gpr}",
                   "diagnostics": [
                        {
                         "range": {