Merge branch 'topic/fb_context2' into 'master'

Reapply "Merge branch 'topic/fb_context' into 'master'"

See merge request eng/ide/ada_language_server!2015

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
@@ -787,20 +829,44 @@ package body LSP.Ada_Handlers.Project_Loading is
 
    procedure Reload_Implicit_Project_Dirs (Self : in out Message_Handler'Class)
    is
-      Project : GPR2.Project.Tree.View_Builder.Object :=
-        GPR2.Project.Tree.View_Builder.Create
-          (Project_Dir => GPR2.Path_Name.Create_Directory ("."),
-           Name        => "default");
-      Values  : GPR2.Containers.Value_List;
-      Opts    : GPR2.Options.Object;
       Success : Boolean;
    begin
       Release_Contexts_And_Project_Info (Self);
-      Self.Project_Tree.Unload;
 
+      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        => Name);
+      Values   : GPR2.Containers.Value_List;
+      Opts     : GPR2.Options.Object;
+      Reporter : GPR2_Reporter;
+   begin
+      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 +875,26 @@ 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);
+           Absent_Dir_Error => GPR2.No_Error,
+           Reporter         => Reporter);
 
-      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.
 

testsuite/ada_lsp/Did_Rename_Files.context_corruption/test.json

@@ -684,6 +684,20 @@
                         }
                      },
                      "alsKind": ["reference"]
+                  },
+                  {
+                     "uri": "$URI{main.adb}",
+                     "range": {
+                        "start": {
+                           "line": 4,
+                           "character": 12
+                        },
+                        "end": {
+                           "line": 4,
+                           "character": 13
+                        }
+                     },
+                     "alsKind": ["call"]
                   }
                ]
             }

testsuite/ada_lsp/rename.out_of_project/default.gpr

@@ -0,0 +1,3 @@
+project Default is
+   for Source_Dirs use ("src");
+end Default;

testsuite/ada_lsp/rename.out_of_project/proc.adb

@@ -0,0 +1,4 @@
+procedure Proc is
+begin
+   Proc;
+end Proc;