Merge branch 'topic/VB23-029' into 'master'

AnthonyLeonardoGracio · AnthonyLeonardoGracio · commit 28600fd91d24 · 2023-03-09T11:04:31.000Z
VB23-029: Use diagnostics to report renaming collisions

See merge request eng/ide/ada_language_server!1155
diff --git a/source/ada/lsp-ada_documents.adb b/source/ada/lsp-ada_documents.adb
@@ -1323,7 +1323,7 @@ package body LSP.Ada_Documents is
    ----------------
 
    procedure Get_Errors
-     (Self    : Document;
+     (Self    : in out Document;
       Context : LSP.Ada_Contexts.Context;
       Changed : out Boolean;
       Errors  : out LSP.Messages.Diagnostic_Vector) is
@@ -2963,6 +2963,22 @@ package body LSP.Ada_Documents is
             character => End_Iterator.Last_UTF16_Offset));
    end To_LSP_Range;
 
+   ---------------------
+   -- To_LSP_Location --
+   ---------------------
+
+   function To_LSP_Location
+     (Self    : Document;
+      Segment : Langkit_Support.Slocs.Source_Location_Range;
+      Kind    : LSP.Messages.AlsReferenceKind_Set := LSP.Messages.Empty_Set)
+      return LSP.Messages.Location is
+   begin
+      return LSP.Messages.Location'
+        (uri  => Self.URI,
+         span => To_LSP_Range (Self, Segment),
+         alsKind => <>);
+   end To_LSP_Location;
+
    ----------
    -- Unit --
    ----------
diff --git a/source/ada/lsp-ada_documents.ads b/source/ada/lsp-ada_documents.ads
@@ -83,6 +83,13 @@ package LSP.Ada_Documents is
       return LSP.Messages.Span;
    --  Convert LAL's Source_Location_Range to LSP's Range
 
+   function To_LSP_Location
+     (Self    : Document;
+      Segment : Langkit_Support.Slocs.Source_Location_Range;
+      Kind    : LSP.Messages.AlsReferenceKind_Set := LSP.Messages.Empty_Set)
+      return LSP.Messages.Location;
+   --  Convert LAL's Source_Location_Range and document's uri to a LSP location
+
    procedure Apply_Changes
      (Self    : aliased in out Document;
       Version : LSP.Types.LSP_Number;
@@ -99,7 +106,7 @@ package LSP.Ada_Documents is
    --  These requests are meaningful within a document/context pair
 
    procedure Get_Errors
-     (Self    : Document;
+     (Self    : in out Document;
       Context : LSP.Ada_Contexts.Context;
       Changed : out Boolean;
       Errors  : out LSP.Messages.Diagnostic_Vector);
diff --git a/source/ada/lsp-ada_handlers.adb b/source/ada/lsp-ada_handlers.adb
@@ -1147,6 +1147,17 @@ package body LSP.Ada_Handlers is
          Self.Line_Folding_Only := True;
       end if;
 
+      if Value.capabilities.textDocument.publishDiagnostics.Is_Set
+        and then Value.capabilities.textDocument.publishDiagnostics.Value.
+          relatedInformation.Is_Set
+      then
+         --  Client capability to support relatedInformation field in
+         --  diagnostics.
+         Self.Supports_Related_Diagnostics :=
+           Value.capabilities.textDocument.publishDiagnostics.Value.
+             relatedInformation.Value;
+      end if;
+
       if Value.capabilities.textDocument.completion.completionItem.Is_Set
         and then Value.capabilities.textDocument.completion.
           completionItem.Value.snippetSupport = True
@@ -3887,15 +3898,29 @@ package body LSP.Ada_Handlers is
       --  possible to encounter the same Text_Edit more than once, so this
       --  stores all the unique edits
 
-      procedure Process_Context (C : Context_Access);
+      Definition_Node : Defining_Name;
+      --  Used to retrieve the definition node found for a given context
+
+      procedure Process_Context
+        (C               : Context_Access;
+         Definition_Node : out Defining_Name);
       --  Process the rename request for the given context, and add the
       --  edits to `All_Edits`.
 
+      function To_LSP_Diagnostic
+        (Problem         : Laltools.Refactor.Refactoring_Diagnotic'Class;
+         Definition_Node : Defining_Name)
+         return LSP.Messages.Diagnostic;
+      --  Convert a laltool refactoring diagnostic into a LSP one.
+
       ---------------------
       -- Process_Context --
       ---------------------
 
-      procedure Process_Context (C : Context_Access) is
+      procedure Process_Context
+        (C               : Context_Access;
+         Definition_Node : out Defining_Name)
+      is
          use GNATCOLL.Projects;
          use Laltools.Refactor.Safe_Rename;
 
@@ -4145,6 +4170,8 @@ package body LSP.Ada_Handlers is
          end Process_References;
 
       begin
+         Definition_Node := Definition;
+
          if Definition.Is_Null then
             return;
          end if;
@@ -4169,31 +4196,94 @@ package body LSP.Ada_Handlers is
          Process_File_Renames;
       end Process_Context;
 
+      -----------------------
+      -- To_LSP_Diagnostic --
+      -----------------------
+
+      function To_LSP_Diagnostic
+        (Problem         : Laltools.Refactor.Refactoring_Diagnotic'Class;
+         Definition_Node : Defining_Name)
+         return LSP.Messages.Diagnostic
+      is
+         Diagnostic : LSP.Messages.Diagnostic;
+      begin
+         Diagnostic := LSP.Messages.Diagnostic'
+           (span               =>
+              To_Span (Definition_Node.Sloc_Range),
+            severity           => (True, LSP.Messages.Error),
+            code               => <>,
+            codeDescription    => <>,
+            source             =>
+              (True, To_Virtual_String ("Ada")),
+            message            =>
+              (if Self.Supports_Related_Diagnostics then
+                    VSS.Strings.Conversions.To_Virtual_String
+                 ("Can't rename identifier '"
+                  & Langkit_Support.Text.To_UTF8
+                    (Definition_Node.Text)
+                  & "'")
+               else VSS.Strings.Conversions.To_Virtual_String
+              (Problem.Info)),
+            tags               => <>,
+            relatedInformation => <>);
+
+         if Self.Supports_Related_Diagnostics then
+            Diagnostic.relatedInformation.Append
+              (LSP.Messages.DiagnosticRelatedInformation'(
+               location => LSP.Messages.Location'
+                 (uri     => File_To_URI (Problem.Filename),
+                  span    => To_Span (Problem.Location),
+                  alsKind => <>),
+               message  => VSS.Strings.Conversions.To_Virtual_String
+                 (Problem.Info)));
+         end if;
+
+         return Diagnostic;
+      end To_LSP_Diagnostic;
+
    begin
       for C of Self.Contexts_For_URI (Value.textDocument.uri) loop
-         Process_Context (C);
+         Process_Context (C, Definition_Node);
 
-         --  If problems were found, send an error message and do not proceed
-         --  with the renames.
+         --  If problems were found, send an error reponse and a diagnostic for
+         --  each issue. Do not proceed with the renames.
 
          if not Context_Edits.Diagnostics.Is_Empty then
             return Response : LSP.Messages.Server_Responses.Rename_Response
               (Is_Error => True)
             do
                declare
-                  Error_Message : VSS.String_Vectors.Virtual_String_Vector;
-
+                  Diag_Params : LSP.Messages.PublishDiagnosticsParams;
+                  Diagnostic  : LSP.Messages.Diagnostic;
                begin
+                  --  For each problem detected in a given file by laltools,
+                  --  convert it to a LSP diagnostic and publish them when
+                  --  switching to another file.
+
                   for Problem of Context_Edits.Diagnostics loop
-                     Error_Message.Append
-                       (VSS.Strings.Conversions.To_Virtual_String
-                          (Problem.Info));
+                     Diagnostic := To_LSP_Diagnostic
+                       (Problem, Definition_Node);
+
+                     if To_UTF_8_String (Diag_Params.uri) = "" or else
+                       To_UTF_8_String (Diag_Params.uri) = Problem.Filename
+                     then
+                        Diag_Params.diagnostics.Append (Diagnostic);
+                        Diag_Params.uri := Value.textDocument.uri;
+                     else
+                        Self.Server.On_Publish_Diagnostics (Diag_Params);
+                        Diag_Params.uri := File_To_URI ("");
+                        Diag_Params.diagnostics.Clear;
+                     end if;
                   end loop;
 
+                  if not Diag_Params.diagnostics.Is_Empty then
+                     Self.Server.On_Publish_Diagnostics (Diag_Params);
+                  end if;
+
                   Response.error :=
                     (True,
-                     (code    => LSP.Errors.InvalidRequest,
-                      message => Error_Message.Join_Lines (VSS.Strings.LF),
+                     (code    => LSP.Errors.RequestFailed,
+                      message => <>,
                       data    => Empty));
                end;
             end return;
@@ -6159,16 +6249,16 @@ package body LSP.Ada_Handlers is
      (Self     : access Message_Handler'Class;
       Document : not null LSP.Ada_Documents.Document_Access)
    is
-      Ok   : Boolean;
-      Diag : LSP.Messages.PublishDiagnosticsParams;
+      Changed : Boolean;
+      Diag    : LSP.Messages.PublishDiagnosticsParams;
    begin
       if Self.Diagnostics_Enabled then
          Document.Get_Errors
-           (Self.Contexts.Get_Best_Context (Document.URI).all,
-            Ok,
-            Diag.diagnostics);
+           (Context => Self.Contexts.Get_Best_Context (Document.URI).all,
+            Changed => Changed,
+            Errors  => Diag.diagnostics);
 
-         if Ok then
+         if Changed then
             Diag.uri := Document.URI;
             Self.Server.On_Publish_Diagnostics (Diag);
          end if;
diff --git a/source/ada/lsp-ada_handlers.ads b/source/ada/lsp-ada_handlers.ads
@@ -294,6 +294,9 @@ private
       Line_Folding_Only : Boolean := False;
       --  Client capabilities, folding only per lines
 
+      Supports_Related_Diagnostics : Boolean := False;
+      --  Client capabilities to support diagnostics' relatedInformation.
+
       Completion_Snippets_Enabled : Boolean := False;
       --  True if the client supports completion snippets
 
diff --git a/source/protocol/lsp-errors.adb b/source/protocol/lsp-errors.adb
@@ -34,7 +34,9 @@ package body LSP.Errors is
       ServerNotInitialized => -32002,
       UnknownErrorCode     => -32001,
       RequestCancelled     => -32800,
-      ContentModified      => -32801);
+      ContentModified      => -32801,
+      ServerCancelled      => -32802,
+      RequestFailed        => -32803);
 
    ------------------------
    -- Read_ResponseError --
diff --git a/source/protocol/lsp-errors.ads b/source/protocol/lsp-errors.ads
@@ -35,7 +35,9 @@ package LSP.Errors is
       ServerNotInitialized,
       UnknownErrorCode,
       RequestCancelled,
-      ContentModified);
+      ContentModified,
+      ServerCancelled,
+      RequestFailed);
 
    type ResponseError is record
       code    : ErrorCodes;
diff --git a/testsuite/ada_lsp/SA11-038_Name_Collision/test.json b/testsuite/ada_lsp/SA11-038_Name_Collision/test.json
@@ -65,6 +65,9 @@
                      "foldingRange": {
                         "lineFoldingOnly": true
                      },
+                     "publishDiagnostics": {
+                        "relatedInformation": true
+                     },
                      "selectionRange": {},
                      "callHierarchy": {}
                   }
@@ -162,12 +165,55 @@
          },
          "wait": [
             {
+               "jsonrpc": "2.0",
+               "method": "textDocument/publishDiagnostics",
+               "params": {
+                 "uri": "$URI{main.adb}",
+                 "diagnostics": [
+                   {
+                     "range": {
+                       "start": {
+                         "line": 1,
+                         "character": 3
+                       },
+                       "end": {
+                         "line": 1,
+                         "character": 4
+                       }
+                     },
+                     "severity": 1,
+                     "source": "Ada",
+                     "message": "Can't rename identifier 'A'",
+                     "relatedInformation": [
+                       {
+                         "location": {
+                           "uri": "$URI{main.adb}",
+                           "range": {
+                             "start": {
+                               "line": 2,
+                               "character": 3
+                             },
+                             "end": {
+                               "line": 2,
+                               "character": 4
+                             }
+                           }
+                         },
+                         "message": "Renaming A to B creates a name collision with <Id \"B\" main.adb:3:4-3:5>"
+                       }
+                     ]
+                   }
+                 ]
+               }
+             },
+             {
+               "jsonrpc": "2.0",
                "id": "ada-4",
                "error": {
-                  "code": -32600,
-                  "message": "Renaming A to B creates a name collision with <Id \"B\" main.adb:3:4-3:5>\n"
+                 "code": -32803,
+                 "message": ""
                }
-            }
+             }           
          ]
       }
    },
