Merge branch 'topic/master_edge_merge' into 'edge'

merge master into edge

See merge request eng/ide/ada_language_server!1139

Author: reznikmm

README.md

@@ -91,6 +91,7 @@ The `ada_language_server` doesn't require any command line options,
 but it understands these options:
 
 * `--tracefile=<FILE>` - Full path to a file containing traces configuration
+* `--config=<FILE>` - Full path to a JSON file containing the server's configuration
 * `--help` - Display supported command like options and exit.
 
 You can turn some debugging and experimental features trought
@@ -99,7 +100,9 @@ You can turn some debugging and experimental features trought
 The server also gets configuration via `workspace/didChangeConfiguration`
 notification and `initializationOptions` of `initialize` request.
 See more [details here](doc/settings.md). Each LSP
-client provides its-own way to set such settings.
+client provides its-own way to set such settings. You can use the `--config`
+option if you want to provide the configuration directly via a JSON file
+instead of specifying it via the requests listed just above.
 
 ## Supported LSP Server Requests
 

source/ada/lsp-ada_driver.adb

@@ -20,6 +20,7 @@
 with Ada.Characters.Latin_1;
 with Ada.Text_IO;
 with Ada.Exceptions;          use Ada.Exceptions;
+with Ada.Strings.Unbounded;
 with GNAT.Command_Line;       use GNAT.Command_Line;
 with GNAT.Traceback.Symbolic; use GNAT.Traceback.Symbolic;
 with GNAT.OS_Lib;
@@ -33,9 +34,11 @@ with VSS.Application;
 with VSS.Standard_Paths;
 with VSS.Strings.Conversions;
 
+with GNATCOLL.JSON;
 with GNATCOLL.Memory;         use GNATCOLL.Memory;
 with GNATCOLL.Traces;         use GNATCOLL.Traces;
 with GNATCOLL.VFS;            use GNATCOLL.VFS;
+with GNATCOLL.Utils;
 
 with LSP.Ada_Handlers;
 with LSP.Ada_Handlers.Named_Parameters_Commands;
@@ -195,7 +198,9 @@ procedure LSP.Ada_Driver is
    GNATdebug              : constant Virtual_File := Create_From_Base
      (".gnatdebug");
 
-   Tracefile_Name         : aliased String_Access;
+   Traces_File_Path       : aliased String_Access;
+   Config_File_Path       : aliased String_Access;
+   Traces_File            : Virtual_File;
    Config_File            : Virtual_File;
    Help_Arg               : aliased Boolean := False;
    Version_Arg            : aliased Boolean := False;
@@ -210,10 +215,18 @@ begin
 
    Define_Switch
      (Cmdline,
-      Output      => Tracefile_Name'Access,
+      Output      => Traces_File_Path'Access,
       Long_Switch => "--tracefile=",
       Help        => "Full path to a file containing traces configuration");
 
+   Define_Switch
+     (Cmdline,
+      Output      => Config_File_Path'Access,
+      Long_Switch => "--config=",
+      Help        => "Full path to a JSON file containing initialization "
+      & "options for the server (i.e: all the settings that can be specified "
+      & "through LSP 'initialize' request's initializattionOptions)");
+
    Define_Switch
      (Cmdline,
       Output      => Language_GPR_Arg'Access,
@@ -251,15 +264,15 @@ begin
    --     - passed on the command line via --tracefile,
    --     - in a .gnatdebug file locally
    --     - in "traces.cfg" in the ALS home directory
-   if Tracefile_Name /= null
-     and then Tracefile_Name.all /= ""
+   if Traces_File_Path /= null
+     and then Traces_File_Path.all /= ""
    then
-      Config_File := Create (+Tracefile_Name.all);
-      if not Config_File.Is_Regular_File then
+      Traces_File := Create (+Traces_File_Path.all);
+      if not Traces_File.Is_Regular_File then
          Ada.Text_IO.Put_Line ("Could not find the specified traces file");
          GNAT.OS_Lib.OS_Exit (1);
       end if;
-      Parse_Config_File (Config_File);
+      Parse_Config_File (Traces_File);
 
    elsif GNATdebug.Is_Regular_File then
       Parse_Config_File (GNATdebug);
@@ -276,8 +289,46 @@ begin
            ".$T.$$.log:buffer_size=0");
    end if;
 
-   if Tracefile_Name /= null then
-      Free (Tracefile_Name);
+   if Traces_File_Path /= null then
+      Free (Traces_File_Path);
+   end if;
+
+   --  Look for a config file, that contains the configuration for the server
+   --  (i.e: the configuration that can be specified through the 'initialize'
+   --  request initializationOptions).
+
+   if Config_File_Path /= null
+     and then Config_File_Path.all /= ""
+   then
+      Config_File := Create (+Config_File_Path.all);
+
+      if not Config_File.Is_Regular_File then
+         Ada.Text_IO.Put_Line ("Could not find the specified config file");
+         GNAT.OS_Lib.OS_Exit (1);
+      end if;
+
+      declare
+         JSON_Contents : GNAT.Strings.String_Access := Config_File.Read_File;
+         Parse_Result  : GNATCOLL.JSON.Read_Result;
+      begin
+         Parse_Result := GNATCOLL.JSON.Read (JSON_Contents.all);
+         GNAT.Strings.Free (JSON_Contents);
+
+         if not Parse_Result.Success then
+            Ada.Text_IO.Put_Line
+              ("Error when parsing config file at "
+               & GNATCOLL.Utils.Image (Parse_Result.Error.Line, 1)
+               & ":"
+               & GNATCOLL.Utils.Image (Parse_Result.Error.Column, 1));
+            Ada.Text_IO.Put_Line
+              (Ada.Strings.Unbounded.To_String (Parse_Result.Error.Message));
+            GNAT.OS_Lib.OS_Exit (1);
+         end if;
+
+         Ada_Handler.Change_Configuration (Parse_Result.Value);
+      end;
+
+      Free (Config_File_Path);
    end if;
 
    Server_Trace.Trace ("ALS version: " & $VERSION);

source/ada/lsp-ada_handlers.adb

@@ -27,7 +27,6 @@ with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
 with Ada.Unchecked_Deallocation;
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
-with GNATCOLL.JSON;
 with GNATCOLL.Utils;             use GNATCOLL.Utils;
 
 with GPR2.Containers;
@@ -325,11 +324,6 @@ package body LSP.Ada_Handlers is
    --  Attempt to load the given project file, with the scenario provided.
    --  This unloads all currently loaded project contexts.
 
-   procedure Change_Configuration
-     (Self  : access Message_Handler;
-      Ada   : LSP.Types.LSP_Any);
-   --  Change server configuration with settings from Ada JSON object.
-
    procedure Mark_Source_Files_For_Indexing (Self : access Message_Handler);
    --  Mark all sources in all projects for indexing. This factorizes code
    --  between Load_Project and Load_Implicit_Project.
@@ -4225,8 +4219,8 @@ package body LSP.Ada_Handlers is
    --------------------------
 
    procedure Change_Configuration
-     (Self  : access Message_Handler;
-      Ada   : LSP.Types.LSP_Any)
+     (Self    : access Message_Handler;
+      Options : GNATCOLL.JSON.JSON_Value'Class)
    is
       use type GNATCOLL.JSON.JSON_Value_Type;
 
@@ -4266,9 +4260,9 @@ package body LSP.Ada_Handlers is
       Variables : Scenario_Variable_List;
 
       function Property (Name : String) return VSS.Strings.Virtual_String is
-        (if Ada.Has_Field (Name)
+        (if Options.Has_Field (Name)
          then VSS.Strings.Conversions.To_Virtual_String
-           (String'(Get (Get (Ada, Name))))
+           (String'(Options.Get (Name)))
          else VSS.Strings.Empty_Virtual_String);
 
       ------------------
@@ -4300,7 +4294,7 @@ package body LSP.Ada_Handlers is
                    Value.dynamicRegistration.Is_Set = True;
 
    begin
-      if Ada.Kind = GNATCOLL.JSON.JSON_Object_Type then
+      if Options.Kind = GNATCOLL.JSON.JSON_Object_Type then
          Relocate := Property (relocateBuildTree);
          Root := Property (rootDir);
          Charset := Property (defaultCharset);
@@ -4311,76 +4305,80 @@ package body LSP.Ada_Handlers is
             File := Self.URI_To_File (File);
          end if;
 
-         if Ada.Has_Field (scenarioVariables) and then
-           Ada.Get (scenarioVariables).Kind  = GNATCOLL.JSON.JSON_Object_Type
+         if Options.Has_Field (scenarioVariables) and then
+           Options.Get
+             (scenarioVariables).Kind  = GNATCOLL.JSON.JSON_Object_Type
          then
-            Ada.Get (scenarioVariables).Map_JSON_Object (Add_Variable'Access);
+            Options.Get
+              (scenarioVariables).Map_JSON_Object (Add_Variable'Access);
          end if;
 
          --  It looks like the protocol does not allow clients to say whether
          --  or not they want diagnostics as part of
          --  InitializeParams.capabilities.textDocument. So we support
          --  deactivating of diagnostics via a setting here.
-         if Ada.Has_Field (enableDiagnostics) then
-            Self.Diagnostics_Enabled := Ada.Get (enableDiagnostics);
+         if Options.Has_Field (enableDiagnostics) then
+            Self.Diagnostics_Enabled := Options.Get (enableDiagnostics);
          end if;
 
          --  Similarly to diagnostics, we support selectively activating
          --  indexing in the parameters to this request.
-         if Ada.Has_Field (enableIndexing) then
-            Self.Indexing_Enabled := Ada.Get (enableIndexing);
+         if Options.Has_Field (enableIndexing) then
+            Self.Indexing_Enabled := Options.Get (enableIndexing);
          end if;
 
          --  Retrieve the different textDocument/rename options if specified
 
-         if Ada.Has_Field (renameInComments) then
+         if Options.Has_Field (renameInComments) then
             Self.Options.Refactoring.Renaming.In_Comments :=
-              Ada.Get (renameInComments);
+              Options.Get (renameInComments);
          end if;
 
-         if Ada.Has_Field (foldComments) then
-            Self.Options.Folding.Comments := Ada.Get (foldComments);
+         if Options.Has_Field (foldComments) then
+            Self.Options.Folding.Comments := Options.Get (foldComments);
          end if;
 
          --  Retrieve the number of parameters / components at which point
          --  named notation is used for subprogram/aggregate completion
          --  snippets.
 
-         if Ada.Has_Field (namedNotationThreshold) then
-            Self.Named_Notation_Threshold := Ada.Get (namedNotationThreshold);
+         if Options.Has_Field (namedNotationThreshold) then
+            Self.Named_Notation_Threshold :=
+              Options.Get (namedNotationThreshold);
          end if;
 
-         if Ada.Has_Field (logThreshold) then
-            Self.Log_Threshold := Ada.Get (logThreshold);
+         if Options.Has_Field (logThreshold) then
+            Self.Log_Threshold := Options.Get (logThreshold);
          end if;
 
          --  Check the 'useCompletionSnippets' flag to see if we should use
          --  snippets in completion (if the client supports it).
          if not Self.Completion_Snippets_Enabled then
             Self.Use_Completion_Snippets := False;
-         elsif Ada.Has_Field (useCompletionSnippets) then
-            Self.Use_Completion_Snippets := Ada.Get (useCompletionSnippets);
+         elsif Options.Has_Field (useCompletionSnippets) then
+            Self.Use_Completion_Snippets :=
+              Options.Get (useCompletionSnippets);
          end if;
 
          --  Retrieve the policy for displaying type hierarchy on navigation
          --  requests.
-         if Ada.Has_Field (displayMethodAncestryOnNavigation) then
+         if Options.Has_Field (displayMethodAncestryOnNavigation) then
             Self.Display_Method_Ancestry_Policy :=
               LSP.Messages.AlsDisplayMethodAncestryOnNavigationPolicy'Value
-                (Ada.Get (displayMethodAncestryOnNavigation));
+                (Options.Get (displayMethodAncestryOnNavigation));
          end if;
 
          --  Retrieve the follow symlinks policy.
 
-         if Ada.Has_Field (followSymlinks) then
-            Self.Follow_Symlinks := Ada.Get (followSymlinks);
+         if Options.Has_Field (followSymlinks) then
+            Self.Follow_Symlinks := Options.Get (followSymlinks);
          end if;
 
-         if Ada.Has_Field (documentationStyle) then
+         if Options.Has_Field (documentationStyle) then
             begin
                Self.Options.Documentation.Style :=
                  GNATdoc.Comments.Options.Documentation_Style'Value
-                   (Ada.Get (documentationStyle));
+                   (Options.Get (documentationStyle));
 
             exception
                when Constraint_Error =>
@@ -4392,12 +4390,12 @@ package body LSP.Ada_Handlers is
 
       if not File.Is_Empty then
          Self.Load_Project
-           (File,
-            Variables,
-            Charset,
-            Valid_Project_Configured,
-            Relocate,
-            Root);
+           (Project_File        => File,
+            Scenario            => Variables,
+            Charset             => Charset,
+            Status              => Valid_Project_Configured,
+            Relocate_Build_Tree => Relocate,
+            Root_Dir            => Root);
       end if;
 
       Self.Ensure_Project_Loaded;

source/ada/lsp-ada_handlers.ads

@@ -23,6 +23,7 @@ with Ada.Containers.Hashed_Sets;
 with Ada.Strings.Unbounded;
 with VSS.String_Vectors;
 
+with GNATCOLL.JSON;
 with GNATCOLL.VFS;    use GNATCOLL.VFS;
 with GNATCOLL.Traces;
 
@@ -71,6 +72,11 @@ package LSP.Ada_Handlers is
    --  This procedure will be called when an unexpected error is raised in the
    --  request processing loop.
 
+   procedure Change_Configuration
+     (Self    : access Message_Handler;
+      Options : GNATCOLL.JSON.JSON_Value'Class);
+   --  Change server configuration with settings from Ada JSON object.
+
    procedure Stop_File_Monitoring (Self : access Message_Handler);
 
    procedure Cleanup (Self : access Message_Handler);

source/tester/tester-tests.adb

@@ -36,7 +36,7 @@ with Tester.Macros;
 
 package body Tester.Tests is
 
-   Max_Wait : constant := 4.0;
+   Max_Wait : constant := 16.0;
    --  Max number of seconds to wait on a given snippet
 
    type Command_Kind is (Start, Stop, Send, Shell, Append_To_Env, Comment);

testsuite/.als/traces.cfg

@@ -9,7 +9,8 @@
 #ALS.OUT=yes  > inout.txt:buffer_size=0
 
 # Testing should include incremental text changes
-ALS.ALLOW_INCREMENTAL_TEXT_CHANGES=yes #> inout.txt:buffer_size=0
+#ALS.ALLOW_INCREMENTAL_TEXT_CHANGES=yes > inout.txt:buffer_size=0
+ALS.ALLOW_INCREMENTAL_TEXT_CHANGES=yes
 
 # Activate navigation warnings in test mode
 ALS.NOTIFICATIONS_FOR_IMPRECISE_NAVIGATION=yes

testsuite/ada_lsp/refactoring_replace_type/Q817-007/test.json

@@ -108,7 +108,16 @@
                }
             }
          },
-         "wait": []
+         "wait": [
+                {
+                    "jsonrpc": "2.0",
+                    "id": 2,
+                    "method": "window/workDoneProgress/create",
+                    "params": {
+                        "token": "<ANY>"
+                    }
+                }
+	 ]
       }
    },
    {

testsuite/ada_lsp/refactoring_sort_dependencies/SA22-035/test.json

@@ -107,7 +107,16 @@
                }
             }
          },
-         "wait": []
+         "wait": [
+                {
+                    "jsonrpc": "2.0",
+                    "id": 2,
+                    "method": "window/workDoneProgress/create",
+                    "params": {
+                        "token": "<ANY>"
+                    }
+                }
+         ]
       }
    },
    {
@@ -283,4 +292,4 @@
          "exit_code": 0
       }
    }
-]
+]