Merge remote branch 'origin/master' into edge

Author: automatic-merge

.gitlab-ci.yml

@@ -83,6 +83,9 @@ build_and_test:
     - cp -r $ANOD_DEFAULT_SANDBOX_DIR/log $CI_PROJECT_DIR/anod-logs
     - echo -e "\e[0Ksection_end:`date +%s`:prepare_artifacts\r\e[0K"
 
+    - if [ ! -z ${FAILED+x} ]; then cat $CI_PROJECT_DIR/als_xunit_output.xml; fi
+    - if [ ! -z ${FAILED+x} ]; then cat $CI_PROJECT_DIR/vscode_xunit_output.xml; fi
+
     - if [ ! -z ${FAILED+x} ]; then echo "There was at least one testcase failure" && exit 1; fi
 
   artifacts:

source/ada/lsp-ada_handlers.adb

@@ -94,6 +94,7 @@ with LSP.Errors;
 with LSP.Formatters.Texts;
 with LSP.Generic_Cancel_Check;
 with LSP.GNATCOLL_Tracers.Handle;
+with LSP.Predefined_Completion;
 with LSP.Search;
 with LSP.Server_Notifications.DidChange;
 with LSP.Servers;
@@ -3028,24 +3029,48 @@ package body LSP.Ada_Handlers is
 
          Decl_Text          : VSS.Strings.Virtual_String;
          Qualifier_Text     : VSS.Strings.Virtual_String;
-         Comments_Text      : VSS.Strings.Virtual_String;
+         Documentation_Text : VSS.Strings.Virtual_String;
          Location_Text      : VSS.Strings.Virtual_String;
          Aspects_Text       : VSS.Strings.Virtual_String;
 
       begin
-         if Decl.Is_Null or else Self.Is_Canceled.all then
+         --  Return immediately if the request has been canceled
+         if Self.Is_Canceled.all then
             return;
          end if;
 
-         LSP.Ada_Documentation.Get_Tooltip_Text
-           (BD                 => Decl,
-            Style              => Context.Get_Documentation_Style,
-            Declaration_Text   => Decl_Text,
-            Qualifier_Text     => Qualifier_Text,
-            Location_Text      => Location_Text,
-            Documentation_Text => Comments_Text,
-            Aspects_Text       => Aspects_Text);
+         if Decl.Is_Null then
+
+            --  There is no declaration for the hovered node: ask the predefined
+            --  entities' completion provider (attributes, pragmas, aspects) for
+            --  a tooltip text if it can.
+            declare
+               Node : constant Libadalang.Analysis.Ada_Node := Self.Get_Node_At
+                 (Context.all, Value);
+            begin
+               if not Node.Is_Null
+                 and then Node.Kind in Libadalang.Common.Ada_Identifier_Range
+               then
+                  LSP.Predefined_Completion.Get_Tooltip_Text
+                    (Node               => Node.As_Identifier,
+                     Declaration_Text   => Decl_Text,
+                     Documentation_Text => Documentation_Text);
+               end if;
+            end;
+         else
+            --  We have resolved the hovered node to its declaration: use
+            --  the default tooltip provider, based on GNATdoc.
+            LSP.Ada_Documentation.Get_Tooltip_Text
+              (BD                 => Decl,
+               Style              => Context.Get_Documentation_Style,
+               Declaration_Text   => Decl_Text,
+               Qualifier_Text     => Qualifier_Text,
+               Location_Text      => Location_Text,
+               Documentation_Text => Documentation_Text,
+               Aspects_Text       => Aspects_Text);
+         end if;
 
+         --  Return if no provider has been able to compute text for a tooltip.
          if Decl_Text.Is_Empty then
             return;
          end if;
@@ -3075,28 +3100,30 @@ package body LSP.Ada_Handlers is
          --  In addition, append the project's name if we are dealing with an
          --  aggregate project.
 
-         Location_Text := LSP.Utils.Node_Location_Image (Decl);
+         if not Decl.Is_Null then
+            Location_Text := LSP.Utils.Node_Location_Image (Decl);
 
-         if Self.Project_Tree.Root_Project.Kind in GPR2.Aggregate_Kind then
-            Location_Text.Append (VSS.Characters.Latin.Line_Feed);
-            Location_Text.Append ("As defined in project ");
-            Location_Text.Append (Context.Id);
-            Location_Text.Append (" (other projects skipped).");
-         end if;
+            if Self.Project_Tree.Root_Project.Kind in GPR2.Aggregate_Kind then
+               Location_Text.Append (VSS.Characters.Latin.Line_Feed);
+               Location_Text.Append ("As defined in project ");
+               Location_Text.Append (Context.Id);
+               Location_Text.Append (" (other projects skipped).");
+            end if;
 
-         Response.Value.contents.MarkedString_Vector.Append
-           (LSP.Structures.MarkedString'
-              (Is_Virtual_String => True,
-               Virtual_String    => Location_Text));
+            Response.Value.contents.MarkedString_Vector.Append
+              (LSP.Structures.MarkedString'
+                 (Is_Virtual_String => True,
+                  Virtual_String    => Location_Text));
+         end if;
 
          --  Append the comments associated with the basic declaration if any.
 
-         if not Comments_Text.Is_Empty then
+         if not Documentation_Text.Is_Empty then
             Response.Value.contents.MarkedString_Vector.Append
               (LSP.Structures.MarkedString'
                  (Is_Virtual_String => False,
                   language          => "plaintext",
-                  value             => Comments_Text));
+                  value             => Documentation_Text));
          end if;
 
          --  Append text of aspects

source/ada/lsp-predefined_completion.adb

@@ -28,6 +28,7 @@ with VSS.Strings.Conversions;
 
 with LSP.Enumerations;
 with LSP.Predefined_Completion.Ada2012;
+with Libadalang.Common;
 
 package body LSP.Predefined_Completion is
 
@@ -277,4 +278,52 @@ package body LSP.Predefined_Completion is
       end;
    end Get_Output;
 
+   ----------------------
+   -- Get_Tooltip_Text --
+   ----------------------
+
+   procedure Get_Tooltip_Text
+     (Node               : Libadalang.Analysis.Identifier;
+      Declaration_Text   : out VSS.Strings.Virtual_String;
+      Documentation_Text : out VSS.Strings.Virtual_String)
+   is
+      use Libadalang.Common;
+
+      Filtered_Items : CompletionItem_Vector;
+      Prefix         : VSS.Strings.Virtual_String;
+      Parent         : constant Libadalang.Analysis.Ada_Node :=
+        (if Node.Is_Null then Libadalang.Analysis.No_Ada_Node
+         else Node.Parent);
+      Item           : CompletionItem;
+   begin
+      --  Return immediately if the node is null of if its parent is null
+      if Node.Is_Null or else Parent.Is_Null then
+         return;
+      end if;
+
+      --  Get the attribute/aspect/pragma completion item corresponding to the
+      --  given node
+
+      Prefix := VSS.Strings.To_Virtual_String (Node.Text);
+
+      case Parent.Kind is
+         when Ada_Attribute_Ref_Range =>
+            Get_Attributes (Prefix => Prefix, Result => Filtered_Items);
+
+         when Ada_Aspect_Assoc_Range =>
+            Get_Aspects (Prefix => Prefix, Result => Filtered_Items);
+
+         when Ada_Pragma_Node_Range =>
+            Get_Pragmas (Prefix => Prefix, Result => Filtered_Items);
+
+         when others =>
+            return;
+      end case;
+
+      Item := Filtered_Items.First_Element;
+
+      Declaration_Text := Item.detail;
+      Documentation_Text := Item.documentation.Value.Virtual_String;
+   end Get_Tooltip_Text;
+
 end LSP.Predefined_Completion;

source/ada/lsp-predefined_completion.ads

@@ -20,6 +20,7 @@ with GNATCOLL.Traces; use GNATCOLL.Traces;
 with VSS.Strings;
 
 with LSP.Structures;  use LSP.Structures;
+with Libadalang.Analysis;
 
 package LSP.Predefined_Completion is
 
@@ -43,4 +44,19 @@ package LSP.Predefined_Completion is
       Result : in out CompletionItem_Vector);
    --  Return completion for pragmas, filtering the results using Prefix.
 
+   procedure Get_Tooltip_Text
+     (Node               : Libadalang.Analysis.Identifier;
+      Declaration_Text   : out VSS.Strings.Virtual_String;
+      Documentation_Text : out VSS.Strings.Virtual_String);
+   --  Get all the information needed to produce tooltips (hover and completion
+   --  requests) for the given node, if it's a predefined entity (e.g: aspect,
+   --  pragma or attribute).
+   --
+   --  @param Node
+   --    The predefined entity's node.
+   --  @param Declaration_Text
+   --    Contains the code corresponding to the predefined entity's declaration.
+   --  @param Documentation_Text
+   --    Contains the documentation associated to the predefined entity.
+
 end LSP.Predefined_Completion;

source/gpr/lsp-gpr_client_capabilities.adb

@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 2023, AdaCore                       --
+--                                                                          --
+-- This is free software;  you can redistribute it  and/or modify it  under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  This software is distributed in the hope  that it will be useful, --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+pragma Ada_2022;
+
+with VSS.String_Vectors;
+
+with LSP.Structures.Unwrap;
+
+package body LSP.GPR_Client_Capabilities is
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize
+     (Self  : in out Client_Capability'Class;
+      Value : LSP.Structures.InitializeParams) is
+   begin
+      Self.Value := Value;
+   end Initialize;
+
+   --------------------
+   -- Resolve_Lazily --
+   --------------------
+
+   function Resolve_Lazily (Self : Client_Capability'Class) return Boolean is
+      use LSP.Structures.Unwrap;
+
+      List : constant VSS.String_Vectors.Virtual_String_Vector :=
+        properties
+          (resolveSupport
+             (completionItem
+                (completion
+                   (Self.Value.capabilities.textDocument))));
+
+   begin
+      return List.Contains ("detail") and then List.Contains ("documentation");
+   end Resolve_Lazily;
+
+end LSP.GPR_Client_Capabilities;

source/gpr/lsp-gpr_client_capabilities.ads

@@ -0,0 +1,40 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 2023, AdaCore                       --
+--                                                                          --
+-- This is free software;  you can redistribute it  and/or modify it  under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  This software is distributed in the hope  that it will be useful, --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+with LSP.Structures;
+
+package LSP.GPR_Client_Capabilities is
+
+   type Client_Capability is tagged limited private;
+   --  This type holds client initialization response and provides handy
+   --  queries on the client capabilities
+
+   procedure Initialize
+     (Self  : in out Client_Capability'Class;
+      Value : LSP.Structures.InitializeParams);
+   --  Save initialize parameters
+
+   function Resolve_Lazily (Self : Client_Capability'Class) return Boolean;
+   --  Returns True when resolve contains `documentation` and `details`
+
+private
+
+   type Client_Capability is tagged limited record
+      Value : LSP.Structures.InitializeParams;
+   end record;
+
+end LSP.GPR_Client_Capabilities;