Merge remote branch 'origin/master' into edge

.vscode/settings.json.tmpl

@@ -80,8 +80,7 @@
    "triggerTaskOnSave.tasks": {
       // To work with automatically provided tasks, they
       // must be provided without the `ada: ` prefix.
-      "Compile current file": ["*.adb"],
-      "Check current file": ["*.ads"]
+      "Check current file": ["*.ads", "*.adb"]
    },
    "triggerTaskOnSave.restart": true,
    "files.watcherExclude": {

source/ada/lsp-ada_contexts.adb

@@ -485,7 +485,9 @@ package body LSP.Ada_Contexts is
       Callback : not null access procedure
         (File : GNATCOLL.VFS.Virtual_File;
          Name : Libadalang.Analysis.Defining_Name;
-         Stop : in out Boolean))
+         Stop : in out Boolean);
+      Unit_Prefix : VSS.Strings.Virtual_String :=
+        VSS.Strings.Empty_Virtual_String)
    is
       function Get_Defining_Name
         (File : GNATCOLL.VFS.Virtual_File;
@@ -512,7 +514,11 @@ package body LSP.Ada_Contexts is
 
    begin
       Self.Source_Files.Get_Any_Symbol
-        (Pattern, Only_Public, Get_Defining_Name'Access, Callback);
+        (Pattern           => Pattern,
+         Only_Public       => Only_Public,
+         Get_Defining_Name => Get_Defining_Name'Access,
+         Callback          => Callback,
+         Unit_Prefix       => Unit_Prefix);
    end Get_Any_Symbol;
 
    -----------------

source/ada/lsp-ada_contexts.ads

@@ -245,11 +245,15 @@ package LSP.Ada_Contexts is
       Callback    : not null access procedure
         (File : GNATCOLL.VFS.Virtual_File;
          Name : Libadalang.Analysis.Defining_Name;
-         Stop : in out Boolean));
+         Stop : in out Boolean);
+      Unit_Prefix : VSS.Strings.Virtual_String :=
+        VSS.Strings.Empty_Virtual_String);
    --  Find symbols starting with given Prefix in all files of the context and
    --  call Callback for each. Name could contain a stale reference if the File
    --  was updated since last indexing operation. If Only_Public is True it
    --  will skip any "private" symbols (like symbols in private part or body).
+   --  Unit_Prefix is used for additional filtering: when specified, only the
+   --  symbols declared in this non-visible unit will be returned.
 
    function Charset (Self : Context) return String;
    --  Return the charset for this context

source/ada/lsp-ada_driver.adb

@@ -74,6 +74,7 @@ with LSP.Ada_Handlers.Source_Dirs_Commands;
 with LSP.Ada_Handlers.Suspend_Executions;
 with LSP.Ada_Tokens_Full;
 with LSP.Ada_Tokens_Range;
+with LSP.Default_Message_Handlers;
 with LSP.GNATCOLL_Trace_Streams;
 with LSP.GNATCOLL_Tracers;
 with LSP.GPR_Handlers;
@@ -82,14 +83,20 @@ with LSP.GPR_Did_Change_Document;
 with LSP.Memory_Statistics;
 with LSP.Predefined_Completion;
 with LSP.Secure_Message_Loggers;
+with LSP.Server_Jobs;
 with LSP.Server_Notifications.DidChange;
 with LSP.Server_Notifications.DidChangeConfiguration;
-with LSP.Server_Requests.Definition;
+with LSP.Server_Notifications.DidChangeWorkspaceFolders;
+with LSP.Server_Notifications.DidClose;
+with LSP.Server_Notifications.DidOpen;
+with LSP.Server_Notifications.Exits;
 with LSP.Server_Requests.Declaration;
+with LSP.Server_Requests.Definition;
 with LSP.Server_Requests.DocumentSymbol;
 with LSP.Server_Requests.ExecuteCommand;
 with LSP.Server_Requests.FoldingRange;
 with LSP.Server_Requests.Hover;
+with LSP.Server_Requests.Initialize;
 with LSP.Server_Requests.References;
 with LSP.Server_Requests.Tokens_Full;
 with LSP.Server_Requests.Tokens_Range;
@@ -232,6 +239,10 @@ procedure LSP.Ada_Driver is
      LSP.Ada_Tokens_Range.Ada_Tokens_Range_Handler
        (Ada_Handler'Unchecked_Access);
 
+   Ada_Fence_Message_Handler : aliased
+     LSP.Default_Message_Handlers.Default_Message_Handler;
+   --  A shared handler with Fense priority
+
    GPR_Did_Change_Doc_Handler : aliased
      LSP.GPR_Did_Change_Document.GPR_Did_Change_Handler
        (GPR_Handler'Unchecked_Access);
@@ -451,6 +462,30 @@ begin
          LSP.Predefined_Completion.Load_Predefined_Completion_Db
            (Server_Trace);
 
+         Ada_Fence_Message_Handler.Initialize
+           (Handler  => Ada_Handler'Unchecked_Access,
+            Priority => LSP.Server_Jobs.Fence);
+
+         Server.Register_Handler
+           (LSP.Server_Requests.Initialize.Request'Tag,
+            Ada_Fence_Message_Handler'Unchecked_Access);
+
+         Server.Register_Handler
+           (LSP.Server_Notifications.DidOpen.Notification'Tag,
+            Ada_Fence_Message_Handler'Unchecked_Access);
+
+         Server.Register_Handler
+           (LSP.Server_Notifications.DidClose.Notification'Tag,
+            Ada_Fence_Message_Handler'Unchecked_Access);
+
+         Server.Register_Handler
+           (LSP.Server_Notifications.DidChangeWorkspaceFolders.Notification'Tag,
+            Ada_Fence_Message_Handler'Unchecked_Access);
+
+         Server.Register_Handler
+           (LSP.Server_Notifications.Exits.Notification'Tag,
+            Ada_Fence_Message_Handler'Unchecked_Access);
+
          Server.Register_Handler
            (LSP.Server_Notifications.DidChangeConfiguration.Notification'Tag,
             Ada_Did_Change_Handler'Unchecked_Access);
@@ -501,7 +536,8 @@ begin
             In_Logger  => (if In_Trace.Is_Active
                            then In_Logger'Unchecked_Access else null),
             Out_Logger => (if Out_Trace.Is_Active
-                           then Out_Logger'Unchecked_Access else null));
+                           then Out_Logger'Unchecked_Access else null),
+            Priority   => LSP.Server_Jobs.Low);
       end if;
    exception
       when E : others =>

source/ada/lsp-ada_file_sets.adb

@@ -16,12 +16,15 @@
 ------------------------------------------------------------------------------
 
 with Langkit_Support.Symbols;     use Langkit_Support.Symbols;
+with Langkit_Support.Text;
 with Libadalang.Common;           use Libadalang.Common;
 with Libadalang.Iterators;
 with Libadalang.Sources;
 
 with LSP.Predicates;
 
+with VSS.Strings.Conversions;
+
 package body LSP.Ada_File_Sets is
 
    procedure Flush_File_Index
@@ -91,7 +94,9 @@ package body LSP.Ada_File_Sets is
       Callback          : not null access procedure
         (File          : GNATCOLL.VFS.Virtual_File;
          Defining_Name : Libadalang.Analysis.Defining_Name;
-         Stop          : in out Boolean))
+         Stop          : in out Boolean);
+      Unit_Prefix : VSS.Strings.Virtual_String :=
+        VSS.Strings.Empty_Virtual_String)
    is
       use all type LSP.Search.Search_Kind;
 
@@ -105,6 +110,29 @@ package body LSP.Ada_File_Sets is
                    and then Pattern.Get_Whole_Word)
                   or else Pattern.Get_Kind = Start_Word_Text);
 
+      function Matches_Unit_Prefix
+        (Name : Libadalang.Analysis.Defining_Name'Class) return Boolean;
+      --  Return true if the given defining name's unit matches the unit prefix
+      --  given in parameter.
+
+      -------------------------
+      -- Matches_Unit_Prefix --
+      -------------------------
+
+      function Matches_Unit_Prefix
+        (Name : Libadalang.Analysis.Defining_Name'Class) return Boolean
+      is
+         Unit_Root_Decl : constant Libadalang.Analysis.Basic_Decl :=
+           Name.P_Enclosing_Compilation_Unit.P_Decl;
+         Unit_Name      : constant VSS.Strings.Virtual_String :=
+           VSS.Strings.Conversions.To_Virtual_String
+             (Langkit_Support.Text.To_UTF8
+                (Unit_Root_Decl.P_Fully_Qualified_Name));
+      begin
+         return Unit_Prefix.Is_Empty
+           or else Unit_Name.Starts_With (Unit_Prefix);
+      end Matches_Unit_Prefix;
+
    begin
       if Use_Celling then
          Cursor := Self.All_Symbols.Ceiling (Pattern.Get_Canonical_Pattern);
@@ -139,7 +167,9 @@ package body LSP.Ada_File_Sets is
             for Item of Self.All_Symbols (Cursor) loop
                if not Only_Public or else Item.Is_Public then
                   Defining_Name := Get_Defining_Name (Item.File, Item.Loc);
-                  if not Defining_Name.Is_Null then
+                  if not Defining_Name.Is_Null
+                    and then Matches_Unit_Prefix (Defining_Name)
+                  then
                      Callback (Item.File, Defining_Name, Stop);
                   end if;
                end if;

source/ada/lsp-ada_file_sets.ads

@@ -85,7 +85,9 @@ package LSP.Ada_File_Sets is
       Callback          : not null access procedure
         (File          : GNATCOLL.VFS.Virtual_File;
          Defining_Name : Libadalang.Analysis.Defining_Name;
-         Stop          : in out Boolean));
+         Stop          : in out Boolean);
+      Unit_Prefix : VSS.Strings.Virtual_String :=
+        VSS.Strings.Empty_Virtual_String);
    --  Find symbols starting with given Prefix in all files of the set and
    --  call Callback for each. Get_Defining_Name callback is used for getting
    --  the Defining_Name at the given location Loc in a unit.

source/ada/lsp-ada_handlers-invisibles.adb

@@ -15,8 +15,11 @@
 -- of the license.                                                          --
 ------------------------------------------------------------------------------
 
+with GNATCOLL;
+with GNATCOLL.Utils;
 with GNATCOLL.VFS;
 
+with Langkit_Support.Text;
 with VSS.Strings;
 
 with LSP.Enumerations;
@@ -39,8 +42,6 @@ package body LSP.Ada_Handlers.Invisibles is
       Result : in out LSP.Structures.CompletionList)
    is
       pragma Unreferenced (Result);
-      use all type Libadalang.Common.Token_Kind;
-      use all type Libadalang.Common.Token_Reference;
       use type Ada.Containers.Count_Type;
 
       procedure On_Inaccessible_Name
@@ -79,22 +80,17 @@ package body LSP.Ada_Handlers.Invisibles is
          end if;
       end On_Inaccessible_Name;
 
-      Previous_Tok : constant Libadalang.Common.Token_Reference :=
-         Libadalang.Common.Previous (Token, Exclude_Trivia => True);
-      Dot_Token    : constant Libadalang.Common.Token_Data_Type :=
-        Libadalang.Common.Data
-          (if Libadalang.Common.Is_Trivia (Token)
-            and then Previous_Tok /= Libadalang.Common.No_Token
-           then Previous_Tok
-           else Token);
-
       function Dummy_Canceled return Boolean is (False);
 
+      Unit_Prefix : VSS.Strings.Virtual_String;
+      --  The unit prefix specified before the point of completion, if any
+      --  (e.g: "Ada.Text_IO" when completing "Ada.Text_IO.").
+      --  Used to filter invisible completion items: if there is a unit prefix,
+      --  we want to show only the public symbols declared in this
+      --  non-visible unit.
+
    begin
-      if Libadalang.Common.Kind (Dot_Token) = Ada_Dot then
-         --  Don't provide completion after a dot
-         return;
-      elsif Filter.Is_Numeric_Literal
+      if Filter.Is_Numeric_Literal
         or else Filter.Is_Attribute_Ref
         or else Filter.Is_Aspect
         or else Filter.Is_End_Label
@@ -111,8 +107,7 @@ package body LSP.Ada_Handlers.Invisibles is
       if Node.Is_Null or else
         (not Node.Parent.Is_Null and then Node.Parent.Kind in
            Libadalang.Common.Ada_Defining_Name_Range
-             | Libadalang.Common.Ada_Dotted_Name_Range
-               | Libadalang.Common.Ada_Ada_Node_List_Range)
+             | Libadalang.Common.Ada_Ada_Node_List_Range)
       then
          return;
       end if;
@@ -123,6 +118,20 @@ package body LSP.Ada_Handlers.Invisibles is
          return;
       end if;
 
+      --  We are completing a dotted-name: check if we have a unit prefix
+      if Node.Kind in Libadalang.Common.Ada_Dotted_Name_Range then
+         declare
+            Prefix : constant String :=
+              Langkit_Support.Text.To_UTF8 (Node.Text);
+            Dot_Idx : Integer := -1;
+         begin
+            Dot_Idx := GNATCOLL.Utils.Find_Char (Prefix, '.');
+            Unit_Prefix :=
+              VSS.Strings.Conversions.To_Virtual_String
+                (Prefix (Prefix'First .. Dot_Idx - 1));
+         end;
+      end if;
+
       declare
          Word : constant VSS.Strings.Virtual_String :=
            VSS.Strings.To_Virtual_String
@@ -146,7 +155,8 @@ package body LSP.Ada_Handlers.Invisibles is
                Self.Context.Get_Any_Symbol
                  (Pattern     => Pattern,
                   Only_Public => True,
-                  Callback    => On_Inaccessible_Name'Access);
+                  Callback    => On_Inaccessible_Name'Access,
+                  Unit_Prefix => Unit_Prefix);
 
                for Doc of Self.Handler.Open_Documents loop
                   Doc.Get_Any_Symbol

source/ada/lsp-ada_handlers-project_diagnostics.adb

@@ -143,20 +143,26 @@ package body LSP.Ada_Handlers.Project_Diagnostics is
                   Sloc : constant GPR2.Source_Reference.Object :=
                     GPR2.Message.Sloc (Msg);
                   File : constant GPR2.Path_Name.Object :=
-                    (if Sloc.Is_Defined and then Sloc.Has_Source_Reference then
+                    (if Sloc.Is_Defined and then Sloc.Has_Source_Reference
+                     then
                         GPR2.Path_Name.Create_File
                           (GPR2.Filename_Type (Sloc.Filename))
                      else
                         Self.Handler.Project_Tree.Root_Project.Path_Name);
                begin
-                  Parent_Diagnostic.relatedInformation.Append
-                    (LSP .Structures.DiagnosticRelatedInformation'
-                       (location => LSP.Structures.Location'
-                            (uri     => LSP.Utils.To_URI (File),
-                             a_range => LSP.Utils.To_Range (Sloc),
-                             others  => <>),
-                        message  => VSS.Strings.Conversions.To_Virtual_String
-                          (Msg.Message)));
+                  --  Display a diagnostic for GPR2 messages only if the file
+                  --  attached to the message is defined.
+                  if File.Is_Defined and then File.Has_Value then
+                     Parent_Diagnostic.relatedInformation.Append
+                       (LSP .Structures.DiagnosticRelatedInformation'
+                          (location => LSP.Structures.Location'
+                               (uri     => LSP.Utils.To_URI (File),
+                                a_range => LSP.Utils.To_Range (Sloc),
+                                others  => <>),
+                           message  =>
+                             VSS.Strings.Conversions.To_Virtual_String
+                               (Msg.Message)));
+                  end if;
                end;
 
                --  If we have one error in the GPR2 messages, the parent