Merge remote branch 'origin/master' into edge

(no-precommit-check no-tn-check)

Author: mergerepo

source/ada/lsp-ada_contexts.adb

@@ -841,7 +841,8 @@ package body LSP.Ada_Contexts is
    procedure Index_File
      (Self    : in out Context;
       File    : GNATCOLL.VFS.Virtual_File;
-      Reparse : Boolean := True)
+      Reparse : Boolean := True;
+      PLE     : Boolean := True)
    is
       Unit : constant Libadalang.Analysis.Analysis_Unit :=
         Self.LAL_Context.Get_From_File
@@ -850,34 +851,32 @@ package body LSP.Ada_Contexts is
            Reparse => Reparse);
    begin
       Self.Source_Files.Index_File (File, Unit);
+
+      if PLE then
+         Libadalang.Analysis.Populate_Lexical_Env (Unit);
+      end if;
    end Index_File;
 
    --------------------
    -- Index_Document --
    --------------------
 
    procedure Index_Document
-     (Self     : Context;
+     (Self     : in out Context;
       Document : in out LSP.Ada_Documents.Document)
    is
-      File : constant Ada.Strings.UTF_Encoding.UTF_8_String :=
+      Filename : constant Ada.Strings.UTF_Encoding.UTF_8_String :=
         Self.URI_To_File (Document.URI);
-      Unit : Libadalang.Analysis.Analysis_Unit;
    begin
-      Document.Reset_Symbol_Cache;
       --  Reset cache of symbols to avoid access to stale references
+      Document.Reset_Symbol_Cache;
 
-      --  Preprocess the buffer
-      Unit := Self.LAL_Context.Get_From_File
-        (Filename => File,
-         Charset  => Ada.Strings.Unbounded.To_String (Self.Charset),
-         Reparse  => True);
-
-      --  After creating an analysis unit, populate the lexical env with it:
-      --  we do this to allow Libadalang to do some work in reaction to
-      --  a file being open in the IDE, in order to speed up the response
-      --  to user queries.
-      Libadalang.Analysis.Populate_Lexical_Env (Unit);
+      --  Index the file, calling Populate_Lexical_Env on it to speed up the
+      --  response to user queries.
+      Self.Index_File
+        (File    => Create_From_UTF8 (Filename),
+         Reparse => True,
+         PLE     => True);
    end Index_Document;
 
    -------------

source/ada/lsp-ada_contexts.ads

@@ -190,12 +190,15 @@ package LSP.Ada_Contexts is
    procedure Index_File
      (Self    : in out Context;
       File    : GNATCOLL.VFS.Virtual_File;
-      Reparse : Boolean := True);
+      Reparse : Boolean := True;
+      PLE     : Boolean := True);
    --  Index the given file. This translates to refreshing the Libadalang
    --  Analysis_Unit associated to it.
+   --  If PLE is True, Populate_Lexical_Env is called at the end, which will
+   --  increase the speed of semantic requests.
 
    procedure Index_Document
-     (Self     : Context;
+     (Self     : in out Context;
       Document : in out LSP.Ada_Documents.Document);
    --  Index/reindex the given document in this context
 

source/ada/lsp-ada_handlers-invisibles.adb

@@ -97,7 +97,8 @@ 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_Defining_Name_Range
+             | Libadalang.Common.Ada_Dotted_Name_Range)
       then
          return;
       end if;

source/ada/lsp-ada_handlers.adb

@@ -89,8 +89,11 @@ package body LSP.Ada_Handlers is
    Notifications_For_Imprecise : constant GNATCOLL.Traces.Trace_Handle :=
      GNATCOLL.Traces.Create ("ALS.NOTIFICATIONS_FOR_IMPRECISE_NAVIGATION",
                              GNATCOLL.Traces.Off);
-   --  Whether to send notifications to the client for "imprecise"
-   --  navigation operations.
+
+   Runtime_Indexing : constant GNATCOLL.Traces.Trace_Handle :=
+     GNATCOLL.Traces.Create ("ALS.RUNTIME_INDEXING",
+                             GNATCOLL.Traces.On);
+   --  Trace to enable/disable runtime indexing. Useful for the testsuite.
 
    Is_Parent : constant LSP.Messages.AlsReferenceKind_Set :=
      (Is_Server_Side => True,
@@ -3373,12 +3376,29 @@ package body LSP.Ada_Handlers is
    procedure Mark_Source_Files_For_Indexing (Self : access Message_Handler) is
    begin
       Self.Files_To_Index.Clear;
+
+      --  Mark all the project's source files
       for C of Self.Contexts.Each_Context loop
          for F in C.List_Files loop
             Self.Files_To_Index.Include
               (LSP.Ada_File_Sets.File_Sets.Element (F));
          end loop;
       end loop;
+
+      if Runtime_Indexing.Is_Active then
+         --  Mark all the predefined sources too (runtime)
+         for F in Self.Project_Predefined_Sources.Iterate loop
+            declare
+               File : GNATCOLL.VFS.Virtual_File renames
+                 LSP.Ada_File_Sets.File_Sets.Element (F);
+            begin
+               for Context of Self.Contexts_For_File (File) loop
+                  Self.Files_To_Index.Include (File);
+               end loop;
+            end;
+         end loop;
+      end if;
+
       Self.Total_Files_Indexed := 0;
       Self.Total_Files_To_Index := Positive'Max
         (1, Natural (Self.Files_To_Index.Length));

source/server/lsp-generic_cancel_check.adb

@@ -0,0 +1,39 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                     Copyright (C) 2018-2021, 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.                                                          --
+------------------------------------------------------------------------------
+
+package body LSP.Generic_Cancel_Check is
+
+   Count : Natural := Max_Skip_Count;
+   --  Counter to restrict frequency of Request.Canceled checks
+
+   -----------------------
+   -- Has_Been_Canceled --
+   -----------------------
+
+   function Has_Been_Canceled return Boolean is
+   begin
+      Count := Count - 1;
+
+      if Count = 0 then
+         Count := Max_Skip_Count;
+         return Request.Canceled;
+      else
+         return False;
+      end if;
+   end Has_Been_Canceled;
+
+end LSP.Generic_Cancel_Check;

source/server/lsp-generic_cancel_check.ads

@@ -0,0 +1,36 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                     Copyright (C) 2018-2021, 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.                                                          --
+------------------------------------------------------------------------------
+--
+--  Each server request has an atomic flag to inform the handler that
+--  the request has been canceled. But, under a havy load, a frequent atomic
+--  checking cound generate overhead. This package provides a function to
+--  avoid an extra overhread by reducing atomic flag check frequency.
+
+with LSP.Messages.Server_Requests;
+
+generic
+   Request : in out LSP.Messages.Server_Requests.Server_Request'Class;
+   --  A request to check cancelation
+   Max_Skip_Count : Natural;
+   --  How much checks to skip before make a real atomic flag check
+
+package LSP.Generic_Cancel_Check is
+
+   function Has_Been_Canceled return Boolean
+     with Inline;
+
+end LSP.Generic_Cancel_Check;

source/tester/tester-tests.adb

@@ -39,7 +39,8 @@ package body Tester.Tests is
    type Command_Kind is (Start, Stop, Send, Shell, Comment);
 
    procedure Do_Start
-     (Self    : in out Test'Class);
+     (Self    : in out Test'Class;
+      Command : GNATCOLL.JSON.JSON_Value);
 
    procedure Do_Stop
      (Self    : in out Test'Class;
@@ -53,10 +54,11 @@ package body Tester.Tests is
      (Self    : in out Test'Class;
       Command : GNATCOLL.JSON.JSON_Value);
 
-   function Wait_Factor return Integer;
-   --  Return the factor to multiply the delays with - useful for valgrind
-   --  runs. This is an integer read from the environment variable
-   --  $ALS_WAIT_FACTOR if it is defined.
+   function Wait_Factor (Command : GNATCOLL.JSON.JSON_Value) return Integer;
+   --  Return the factor to multiply the delays with - useful for valgrind runs
+   --  or commands that take longer time.
+   --  This is an integer read from either the "waitFactor" field of Command
+   --  (if any) or the $ALS_WAIT_FACTOR environment variable (if any).
 
    function Is_Has_Pattern (List : GNATCOLL.JSON.JSON_Array) return Boolean;
    --  Check if List in form of ["<HAS>", item1, item2, ...]
@@ -124,6 +126,7 @@ package body Tester.Tests is
       Request : constant GNATCOLL.JSON.JSON_Value := Command.Get ("request");
       Wait    : constant GNATCOLL.JSON.JSON_Array := Command.Get ("wait").Get;
       Sort    : constant GNATCOLL.JSON.JSON_Value := Command.Get ("sortReply");
+
       Text    : constant Ada.Strings.Unbounded.Unbounded_String :=
         Request.Write;
 
@@ -139,7 +142,7 @@ package body Tester.Tests is
          exit when GNATCOLL.JSON.Length (Self.Waits) = 0;
 
          Total_Milliseconds_Waited := Total_Milliseconds_Waited + Timeout;
-         if Total_Milliseconds_Waited > Max_Wait * Wait_Factor
+         if Total_Milliseconds_Waited > Max_Wait * Wait_Factor (Command)
             and then not Self.In_Debug
          then
             declare
@@ -351,7 +354,8 @@ package body Tester.Tests is
    --------------
 
    procedure Do_Start
-     (Self    : in out Test'Class)
+     (Self    : in out Test'Class;
+      Command : GNATCOLL.JSON.JSON_Value)
    is
       function Program_Name (Path : String) return String;
       --  Return full path to an exacutable designated by Path
@@ -371,25 +375,28 @@ package body Tester.Tests is
          end if;
       end Program_Name;
 
-      Command_Line : constant GNAT.OS_Lib.String_Access := Getenv ("ALS");
-
-      Args : Spawn.String_Vectors.UTF_8_String_Vector;
+      Command_Line : constant JSON_Array := Command.Get ("cmd").Get;
+      ALS_Var      : constant GNAT.OS_Lib.String_Access := Getenv ("ALS");
+      ALS_Exe      : constant String :=
+        (if ALS_Var /= null then ALS_Var.all else "");
+      Args         : Spawn.String_Vectors.UTF_8_String_Vector;
    begin
-      if Command_Line = null or else Command_Line.all = "" then
+      if ALS_Exe = "" then
          raise Program_Error with
            "You must specify the language server command line in $ALS";
       end if;
 
-      declare
-         Splits : constant Unbounded_String_Array :=
-           Split (Command_Line.all, ' ');
-      begin
-         Self.Set_Program (Program_Name (To_String (Splits (Splits'First))));
+      --  Set the program using $ALS env variable
+      Self.Set_Program (Program_Name (ALS_Exe));
 
-         for J in Splits'First + 1 .. Splits'Last loop
-            Args.Append (To_String (Splits (J)));
-         end loop;
-      end;
+      --  Set the arguments using the 'cmd' field. Skip the first one, since
+      --  it's "${ALS}".
+      for J in
+        GNATCOLL.JSON.Array_First (Command_Line) + 1 ..
+        GNATCOLL.JSON.Length (Command_Line)
+      loop
+         Args.Append (GNATCOLL.JSON.Get (Command_Line, J).Get);
+      end loop;
 
       Self.Set_Arguments (Args);
       Self.Start;
@@ -781,7 +788,7 @@ package body Tester.Tests is
 
          case Kind is
             when Start =>
-               Self.Do_Start;
+               Self.Do_Start (Value);
             when Stop =>
                Self.Do_Stop (Value);
             when Send =>
@@ -802,7 +809,7 @@ package body Tester.Tests is
          select
             accept Cancel;
          or
-            delay 20.0 * Wait_Factor;
+            delay 20.0 * Wait_Factor (Command);
 
             Ada.Text_IO.Put_Line ("Timeout on command:");
             Ada.Text_IO.Put_Line (Command.Write);
@@ -845,14 +852,26 @@ package body Tester.Tests is
    -- Wait_Factor --
    -----------------
 
-   function Wait_Factor return Integer is
-      Factor : constant GNAT.OS_Lib.String_Access
+   function Wait_Factor (Command : GNATCOLL.JSON.JSON_Value) return Integer is
+      Command_Factor : constant String :=
+        (if Command.Has_Field ("waitFactor") then
+              Command.Get ("waitFactor")
+         else
+            "");
+      Env_Factor     : constant GNAT.OS_Lib.String_Access
         := Getenv ("ALS_WAIT_FACTOR");
+      Factor         : constant String :=
+        (if Command_Factor /= "" then
+            Command_Factor
+         elsif Env_Factor /= null then
+            Env_Factor.all
+         else
+            "");
    begin
-      if Factor = null or else Factor.all = "" then
+      if Factor = "" then
          return 1;
       else
-         return Integer'Value (Factor.all);
+         return Integer'Value (Factor);
       end if;
    end Wait_Factor;
 

testsuite/.als/traces.cfg

@@ -12,3 +12,6 @@ ALS.ALLOW_INCREMENTAL_TEXT_CHANGES=yes > inout.txt:buffer_size=0
 
 # Activate navigation warnings in test mode
 ALS.NOTIFICATIONS_FOR_IMPRECISE_NAVIGATION=yes
+
+# Disable runtime indexing for most tests
+ALS.RUNTIME_INDEXING=no

testsuite/ada_lsp/completion.invisible.runtime/default.gpr

@@ -0,0 +1,2 @@
+project Default is
+end Default;

testsuite/ada_lsp/completion.invisible.runtime/main.adb

@@ -0,0 +1,5 @@
+
+procedure Main is
+begin
+   Ada.Te
+end Main;