Merge branch 'topic/fallback_contexts' into 'master'

Use fallback context for non-source Ada files

See merge request eng/ide/ada_language_server!1856

Author: AnthonyLeonardoGracio

source/ada/lsp-ada_context_sets.adb

@@ -44,6 +44,7 @@ package body LSP.Ada_Context_Sets is
 
       Self.Map.Clear;
       Self.Total := 0;
+      Self.Fallback_Context := null;
    end Cleanup;
 
    ------------------
@@ -70,16 +71,16 @@ package body LSP.Ada_Context_Sets is
    ----------------------
 
    function Get_Best_Context
-     (Self : Context_Set'Class;
-      URI  : LSP.Structures.DocumentUri) return Context_Access is
+     (Self : Context_Set'Class; URI : LSP.Structures.DocumentUri)
+      return Context_Access is
    begin
       for Context of Self.Contexts loop
          if Context.Is_Part_Of_Project (URI) then
             return Context;
          end if;
       end loop;
 
-      return Self.Contexts.First_Element;
+      return Self.Fallback_Context;
    end Get_Best_Context;
 
    ---------
@@ -113,6 +114,16 @@ package body LSP.Ada_Context_Sets is
       Self.Contexts.Prepend (Item);
       Self.Map.Insert (Item.Id, Item);
       Self.Total := Self.Total + Item.File_Count;
+
+      --  Free any previously set fallback context before
+      --  setting the new one.
+      if Item.Is_Fallback_Context then
+         if Self.Fallback_Context /= null then
+            Self.Fallback_Context.Free;
+            Unchecked_Free (Self.Fallback_Context);
+         end if;
+         Self.Fallback_Context := Item;
+      end if;
    end Prepend;
 
    -------------------------

source/ada/lsp-ada_context_sets.ads

@@ -47,11 +47,12 @@ package LSP.Ada_Context_Sets is
    --  Reload each context in the set
 
    function Get_Best_Context
-     (Self : Context_Set'Class;
-      URI  : LSP.Structures.DocumentUri) return Context_Access;
+     (Self : Context_Set'Class; URI : LSP.Structures.DocumentUri)
+      return Context_Access;
    --  Return the first context in Contexts which contains a project
-   --  which knows about file. Return the first context if no such
-   --  context was found.
+   --  which knows about file.
+   --  If the file is not a known by any project context, return a
+   --  fallback context not linked to any project subtree.
 
    function Total_Source_Files (Self : Context_Set'Class) return Natural;
    --  Number of files in all contexts
@@ -95,12 +96,19 @@ private
       "="             => "=");
 
    type Context_Set is tagged limited record
-      Contexts           : Context_Lists.List;
+      Contexts : Context_Lists.List;
+      --  The list of all contexts.
 
-      Map                : Maps.Map;
-      --  A map from Context.Id to Context access
+      Fallback_Context : Context_Access;
+      --  The fallback context used for files that do not belong
+      --  to any project's subtree.
 
-      Total              : Natural := 0;
+      Map      : Maps.Map;
+      --  A map from Context.Id to Context access.
+
+      Total    : Natural := 0;
+      --  The total number of source files known by all the contexts stored
+      --  in this set.
    end record;
 
 end LSP.Ada_Context_Sets;

source/ada/lsp-ada_contexts.adb

@@ -545,18 +545,25 @@ package body LSP.Ada_Contexts is
       Self.Charset := Ada.Strings.Unbounded.To_Unbounded_String
         ("iso-8859-1");
       Self.Reader_Reference := Create_File_Reader_Reference (File_Reader);
+
+      --  Tab stop is set 1 to disable "visible character guessing" by LAL.
       Self.LAL_Context := Libadalang.Analysis.Create_Context
         (Unit_Provider => Self.Unit_Provider,
          File_Reader   => Self.Reader_Reference,
          With_Trivia   => True,
          Charset       => Self.Get_Charset,
          Tab_Stop      => 1);
       Self.Style := Style;
-
-      --  Tab stop is set 1 to disable "visible character guessing" by LAL.
       Self.Is_Fallback_Context := As_Fallback_Context;
    end Initialize;
 
+   -------------------------
+   -- Is_Fallback_Context --
+   -------------------------
+
+   function Is_Fallback_Context (Self : Context) return Boolean
+   is (Self.Is_Fallback_Context);
+
    ------------------------
    -- Is_Part_Of_Project --
    ------------------------
@@ -565,8 +572,7 @@ package body LSP.Ada_Contexts is
      (Self : Context;
       URI : LSP.Structures.DocumentUri) return Boolean is
    begin
-      return Self.Is_Fallback_Context
-        or else Self.Source_Files.Contains (Self.URI_To_File (URI));
+      return Self.Is_Part_Of_Project (Self.URI_To_File (URI));
    end Is_Part_Of_Project;
 
    ------------------------
@@ -577,8 +583,7 @@ package body LSP.Ada_Contexts is
      (Self : Context;
       File : Virtual_File) return Boolean is
    begin
-      return Self.Is_Fallback_Context
-        or else Self.Source_Files.Contains (File);
+      return Self.Source_Files.Contains (File);
    end Is_Part_Of_Project;
 
    ------------------

source/ada/lsp-ada_contexts.ads

@@ -91,10 +91,11 @@ package LSP.Ada_Contexts is
    procedure Find_All_References
      (Self       : Context;
       Definition : Libadalang.Analysis.Defining_Name;
-      Callback   : not null access procedure
-        (Base_Id : Libadalang.Analysis.Base_Id;
-         Kind    : Libadalang.Common.Ref_Result_Kind;
-         Cancel  : in out Boolean));
+      Callback   :
+        not null access procedure
+          (Base_Id : Libadalang.Analysis.Base_Id;
+           Kind    : Libadalang.Common.Ref_Result_Kind;
+           Cancel  : in out Boolean));
    --  Finds all references to a given defining name in all units of the
    --  context.
 
@@ -124,10 +125,11 @@ package LSP.Ada_Contexts is
    procedure Find_All_Calls
      (Self       : Context;
       Definition : Libadalang.Analysis.Defining_Name;
-      Callback   : not null access procedure
-        (Base_Id : Libadalang.Analysis.Base_Id;
-         Kind    : Libadalang.Common.Ref_Result_Kind;
-         Cancel  : in out Boolean));
+      Callback   :
+        not null access procedure
+          (Base_Id : Libadalang.Analysis.Base_Id;
+           Kind    : Libadalang.Common.Ref_Result_Kind;
+           Cancel  : in out Boolean));
    --  Return all the enclosing entities that call Definition in all sources
    --  known to this project.
 
@@ -147,52 +149,63 @@ package LSP.Ada_Contexts is
      (Self              : Context;
       Definition        : Libadalang.Analysis.Defining_Name;
       Imprecise_Results : out Boolean;
-      Callback          : not null access procedure
-        (Base_Id : Libadalang.Analysis.Base_Id;
-         Kind    : Libadalang.Common.Ref_Result_Kind;
-         Cancel  : in out Boolean));
+      Callback          :
+        not null access procedure
+          (Base_Id : Libadalang.Analysis.Base_Id;
+           Kind    : Libadalang.Common.Ref_Result_Kind;
+           Cancel  : in out Boolean));
    --  Get all the references to a given defining name in all units for
    --  renaming purposes: for instance, when called on a tagged type primitive
    --  definition, references to the base subprograms it inherits and to the
    --  overriding ones are also returned.
 
-   function Is_Part_Of_Project
-     (Self : Context;
-      URI  : LSP.Structures.DocumentUri) return Boolean;
-   --  Check if given file belongs to the project loaded in the Context
+   function Is_Fallback_Context (Self : Context) return Boolean;
+   --  Return true if the given context is used as a fallback (i.e: used for files
+   --  that do not belong to any known project subtree).
 
    function Is_Part_Of_Project
-     (Self : Context;
-      File : GNATCOLL.VFS.Virtual_File) return Boolean;
-   --  Check if given file belongs to the project loaded in the Context
+     (Self : Context; URI : LSP.Structures.DocumentUri) return Boolean;
+   --  Check if the file designated by the given URI belongs to the project
+   --  loaded in the Context.
+   --  This returns False for fallback contexts, since fallback contexts
+   --  are not linked to any project subtree.
 
-   function List_Files (Self : Context'CLass)
-     return LSP.Ada_File_Sets.File_Sets.Set_Iterator_Interfaces
-       .Reversible_Iterator'Class;
+   function Is_Part_Of_Project
+     (Self : Context; File : GNATCOLL.VFS.Virtual_File) return Boolean;
+   --  Check if given file belongs to the project loaded in the Context.
+   --  This returns False for fallback contexts, since fallback contexts
+   --  are not linked to any project subtree.
+
+   function List_Files
+     (Self : Context'CLass)
+      return LSP
+               .Ada_File_Sets
+               .File_Sets
+               .Set_Iterator_Interfaces
+               .Reversible_Iterator'Class;
    --  Return the list of files known to this context.
 
    function File_Count (Self : Context) return Natural;
    --  Return number of files known to this context.
 
-   function Get_PP_Options (Self : Context) return
-     Utils.Command_Lines.Command_Line;
+   function Get_PP_Options
+     (Self : Context) return Utils.Command_Lines.Command_Line;
    --  Return the command line for the Pretty Printer
 
    function Get_Format_Options
      (Self : Context) return Gnatformat.Configuration.Format_Options_Type;
    --  Return the formatting options for Gnatformat
 
-   function Get_Documentation_Style (Self : Context) return
-     GNATdoc.Comments.Options.Documentation_Style;
+   function Get_Documentation_Style
+     (Self : Context) return GNATdoc.Comments.Options.Documentation_Style;
    --  Get the documentation style used for this context.
 
    function Analysis_Units
      (Self : Context) return Libadalang.Analysis.Analysis_Unit_Array;
    --  Return the analysis units for all Ada sources known to this context
 
    function List_Source_Directories
-     (Self                     : Context;
-      Include_Externally_Built : Boolean := False)
+     (Self : Context; Include_Externally_Built : Boolean := False)
       return LSP.Ada_File_Sets.File_Sets.Set;
    --  List the source directories, including externally built projects' source
    --  directories when Include_Externally_Built is set to True.
@@ -220,23 +233,19 @@ package LSP.Ada_Contexts is
    --  increase the speed of semantic requests.
 
    procedure Include_File
-     (Self    : in out Context;
-      File    : GNATCOLL.VFS.Virtual_File);
+     (Self : in out Context; File : GNATCOLL.VFS.Virtual_File);
    --  Includes File in Self's source files
 
    procedure Exclude_File
-     (Self    : in out Context;
-      File    : GNATCOLL.VFS.Virtual_File);
+     (Self : in out Context; File : GNATCOLL.VFS.Virtual_File);
    --  Excludes File from Self's source files
 
    procedure Index_Document
-     (Self     : in out Context;
-      Document : in out LSP.Ada_Documents.Document);
+     (Self : in out Context; Document : in out LSP.Ada_Documents.Document);
    --  Index/reindex the given document in this context
 
    procedure Flush_Document
-     (Self : in out Context;
-      File : GNATCOLL.VFS.Virtual_File);
+     (Self : in out Context; File : GNATCOLL.VFS.Virtual_File);
    --  Revert a document to the state of the file discarding any changes
 
    function LAL_Context
@@ -247,10 +256,11 @@ package LSP.Ada_Contexts is
      (Self        : Context;
       Pattern     : LSP.Search.Search_Pattern'Class;
       Only_Public : Boolean;
-      Callback    : not null access procedure
-        (File : GNATCOLL.VFS.Virtual_File;
-         Name : Libadalang.Analysis.Defining_Name;
-         Stop : in out Boolean);
+      Callback    :
+        not null access procedure
+          (File : GNATCOLL.VFS.Virtual_File;
+           Name : Libadalang.Analysis.Defining_Name;
+           Stop : in out Boolean);
       Unit_Prefix : VSS.Strings.Virtual_String :=
         VSS.Strings.Empty_Virtual_String);
    --  Find symbols that match the given Pattern in all files of the context and