Set an empty GPR2 project tree for the fallback context

Use `fallback_context` for this "in memory" project to avoid
name clash with `default` name of an implicit project.

Refs #1594

Author: reznikmm

source/ada/lsp-ada_context_sets.adb

@@ -75,7 +75,9 @@ package body LSP.Ada_Context_Sets is
       return Context_Access is
    begin
       for Context of Self.Contexts loop
-         if Context.Is_Part_Of_Project (URI) then
+         if not Context.Is_Fallback_Context
+           and then Context.Is_Part_Of_Project (URI)
+         then
             return Context;
          end if;
       end loop;

source/ada/lsp-ada_handlers-project_loading.adb

@@ -104,6 +104,15 @@ package body LSP.Ada_Handlers.Project_Loading is
    --  Reload as project source dirs the directories in
    --  Self.Project_Dirs_Loaded.
 
+   procedure Create_In_Memory_Project
+     (Name         : GPR2.Name_Type;
+      Dirs         : File_Sets.Set;
+      Project_Tree : in out GPR2.Project.Tree.Object;
+      Success      : out Boolean);
+   --  Unload Project_Tree then construct a new project in memory with given
+   --  Name and source Dirs. Return Success=True and resulting Project_Tree
+   --  if everything is fine. Return Success=False otherwise.
+
    procedure Update_Project_Predefined_Sources
      (Self : in out Message_Handler'Class);
    --  Fill Self.Project_Predefined_Sources with loaded project tree runtime
@@ -113,6 +122,68 @@ package body LSP.Ada_Handlers.Project_Loading is
    --  This also indexes immediately any already opened document, creating
    --  the handler's fallback context before for that purpose.
 
+   procedure Create_Fallback_Context (Self : in out Message_Handler'Class);
+   --  Create a fallback context for the given handler's contexts' set.
+
+   -----------------------------
+   -- Create_Fallback_Context --
+   -----------------------------
+
+   procedure Create_Fallback_Context (Self : in out Message_Handler'Class) is
+      use LSP.Ada_Context_Sets;
+      use LSP.Ada_Contexts;
+      use type GNATCOLL.VFS.Virtual_File;
+
+      C : constant Context_Access := new Context (Self.Tracer);
+
+      Reader : LSP.Ada_Handlers.File_Readers.LSP_File_Reader
+        (Self'Unchecked_Access);
+
+      Dirs : File_Sets.Set;
+
+      Project_Tree : GPR2.Project.Tree.Object;
+
+      Success : Boolean;
+   begin
+      Self.Tracer.Trace_Text ("Creating fallback context");
+
+      C.Initialize
+        (File_Reader         => Reader,
+         Follow_Symlinks     => Self.Configuration.Follow_Symlinks,
+         Style               => Self.Configuration.Documentation_Style,
+         As_Fallback_Context => True);
+
+      if Self.Client.Root_Directory /= GNATCOLL.VFS.No_File then
+         Dirs.Insert (Self.Client.Root_Directory);
+      end if;
+
+      Create_In_Memory_Project
+        ("fallback_context", Dirs, Project_Tree, Success);
+
+      pragma Assert
+        (Success, "Can't create an empty project for the fallback context");
+
+      --  Create a basic GPR2_Provider_And_Projects containing only the
+      --  implicit project and load it.
+      declare
+         Provider : Libadalang.Project_Provider.GPR2_Provider_And_Projects :=
+           (Provider =>
+              Libadalang.Project_Provider.Create_Project_Unit_Provider
+                (Tree    => Project_Tree,
+                 Project => Project_Tree.Root_Project),
+            Projects => <>);
+      begin
+         Provider.Projects.Append (Project_Tree.Root_Project);
+
+         C.Load_Project
+           (Provider => Provider,
+            Tree     => Project_Tree,
+            Charset  => "iso-8859-1");
+      end;
+
+      Self.Contexts.Prepend (C);
+   end Create_Fallback_Context;
+
    ---------------------------
    -- Ensure_Project_Loaded --
    ---------------------------
@@ -684,35 +755,6 @@ package body LSP.Ada_Handlers.Project_Loading is
    --------------------------
 
    procedure Enqueue_Indexing_Job (Self : in out Message_Handler'Class) is
-      procedure Create_Fallback_Context (Self : in out Message_Handler'Class);
-      --  Create a fallback context for the given handler's contexts' set.
-
-      -----------------------------
-      -- Create_Fallback_Context --
-      -----------------------------
-
-      procedure Create_Fallback_Context (Self : in out Message_Handler'Class)
-      is
-         use LSP.Ada_Context_Sets;
-         use LSP.Ada_Contexts;
-      begin
-         declare
-            C      : constant Context_Access := new Context (Self.Tracer);
-            Reader :
-              LSP.Ada_Handlers.File_Readers.LSP_File_Reader
-                (Self'Unchecked_Access);
-         begin
-            Self.Tracer.Trace_Text ("Creating fallback context");
-
-            C.Initialize
-              (File_Reader         => Reader,
-               Follow_Symlinks     => Self.Configuration.Follow_Symlinks,
-               Style               => Self.Configuration.Documentation_Style,
-               As_Fallback_Context => True);
-            Self.Contexts.Prepend (C);
-         end;
-      end Create_Fallback_Context;
-
       Files : LSP.Ada_Indexing.File_Sets.Set;
    begin
       --  Create a fallback context before indexing. This allows to
@@ -786,21 +828,44 @@ package body LSP.Ada_Handlers.Project_Loading is
    ----------------------------------
 
    procedure Reload_Implicit_Project_Dirs (Self : in out Message_Handler'Class)
+   is
+      Success : Boolean;
+   begin
+      Release_Contexts_And_Project_Info (Self);
+
+      Create_In_Memory_Project
+        (Name         => "default",
+         Dirs         => Self.Project_Dirs_Loaded,
+         Project_Tree => Self.Project_Tree,
+         Success      => Success);
+
+      if not Success then
+         LSP.Ada_Project_Loading.Set_Load_Status
+           (Self.Project_Status, LSP.Ada_Project_Loading.Invalid_Project);
+      end if;
+   end Reload_Implicit_Project_Dirs;
+
+   ------------------------------
+   -- Create_In_Memory_Project --
+   ------------------------------
+
+   procedure Create_In_Memory_Project
+     (Name         : GPR2.Name_Type;
+      Dirs         : File_Sets.Set;
+      Project_Tree : in out GPR2.Project.Tree.Object;
+      Success      : out Boolean)
    is
       Project : GPR2.Project.Tree.View_Builder.Object :=
         GPR2.Project.Tree.View_Builder.Create
           (Project_Dir => GPR2.Path_Name.Create_Directory ("."),
-           Name        => "default");
+           Name        => Name);
       Values  : GPR2.Containers.Value_List;
       Opts    : GPR2.Options.Object;
-      Success : Boolean;
    begin
-      Release_Contexts_And_Project_Info (Self);
-      Self.Project_Tree.Unload;
-
+      Project_Tree.Unload;
       --  Load all the dirs
 
-      for Dir of Self.Project_Dirs_Loaded loop
+      for Dir of Dirs loop
          Values.Append (Dir.Display_Full_Name);
       end loop;
 
@@ -809,28 +874,25 @@ package body LSP.Ada_Handlers.Project_Loading is
 
       --  First we load the fallback project
       Success :=
-        Self.Project_Tree.Load_Virtual_View
+        Project_Tree.Load_Virtual_View
           (Project,
            Opts,
            With_Runtime     => True,
            Absent_Dir_Error => GPR2.No_Error);
 
-      if not Success then
-         for C in Self.Project_Tree.Log_Messages.Iterate loop
+      if Success then
+         Project_Tree.Update_Sources;
+      else
+         for C in Project_Tree.Log_Messages.Iterate loop
             Tracer.Trace (C.Element.Format);
          end loop;
-         LSP.Ada_Project_Loading.Set_Load_Status
-           (Self.Project_Status, LSP.Ada_Project_Loading.Invalid_Project);
       end if;
 
-      Self.Project_Tree.Update_Sources;
-
    exception
       when E : others =>
-         Tracer.Trace_Exception (E, "Reload_Implicit_Project_Dirs");
-         LSP.Ada_Project_Loading.Set_Load_Status
-           (Self.Project_Status, LSP.Ada_Project_Loading.Invalid_Project);
-   end Reload_Implicit_Project_Dirs;
+         Tracer.Trace_Exception (E, "Create_In_Memory_Project");
+         Success := False;
+   end Create_In_Memory_Project;
 
    --------------------
    -- Reload_Project --

source/ada/lsp-ada_handlers-project_loading.ads

@@ -33,6 +33,9 @@ package LSP.Ada_Handlers.Project_Loading is
    --  4. else if there are multiple projects at the root, warn about it and
    --     load the implicit project
    --  5. else load the implicit project
+   --
+   --  Initially this function guaranteed that the Message_Handler would have
+   --  the project loaded on return, but this is no longer the case.
 
    procedure Reload_Project (Self : in out Message_Handler'CLass);
    --  Clear the current project context and call Ensure_Project_Loaded to

source/ada/lsp-ada_handlers.adb

@@ -254,10 +254,10 @@ package body LSP.Ada_Handlers is
       --  Check if the given file belongs to the runtime.
 
       function Is_A_Source (Self : LSP.Ada_Contexts.Context) return Boolean is
-        ((Is_Runtime_File and then not Self.Is_Fallback_Context)
-         or else Self.Is_Part_Of_Project (File));
+        (not Self.Is_Fallback_Context and then
+           (Is_Runtime_File or else Self.Is_Part_Of_Project (File)));
       --  Return True if File is a source of the project held by Context
-      --  Avoid considering runtime files as sources for the fallback context,
+      --  Avoid considering runtime files as sources and the fallback context,
       --  if there is no context available for this file then we will still
       --  use the fallback later.