Merge branch 'config_file' into 'master'

Support gprbuild's configuration file

See merge request eng/ide/ada_language_server!1846

Author: ogorodnik

doc/settings.md

@@ -101,6 +101,7 @@ Settings taken into account only from the Ada & SPARK VS Code extension:
 Settings understood by the Ada Language Server itself, independently from the LSP client:
 
 * [projectFile](#projectfile)
+* [gprConfigurationFile](#gprconfigurationfile)
 * [scenarioVariables](#scenariovariables)
 * [defaultCharset](#defaultcharset)
 * [relocateBuildTree](#relocatebuildtree)
@@ -156,6 +157,16 @@ root folder, then ALS will use it.
     'projectFile': 'gnat/lsp_server.gpr'
 ```
 
+### gprConfigurationFile
+
+You can configure the GPRBuild configuration file via the
+`gprConfigurationFile` key. The setting has a string value, that points to
+the `.cgpr` file. It could be a full path or relative path.
+
+```javascript
+    'gprConfigurationFile': 'gnat/lsp_server.cgpr'
+```
+
 ### scenarioVariables
 
 You can configure scenario variables via the `scenarioVariables` key.

integration/vscode/ada/package.json

@@ -285,6 +285,13 @@
                         "description": "GPR project file (*.gpr) for this workspace.\n\nIt is recommended to set this to a relative path starting at the root of the workspace.",
                         "order": 0
                     },
+                    "ada.gprConfigurationFile": {
+                        "scope": "window",
+                        "type": "string",
+                        "default": null,
+                        "description": "GPR configuration file (*.cgpr) for this workspace.\n\nIt is recommended to set this to a relative path starting at the root of the workspace.",
+                        "order": 0
+                    },
                     "ada.scenarioVariables": {
                         "scope": "window",
                         "type": "object",

integration/vscode/ada/schemas/als-settings-schema.json

@@ -7,6 +7,11 @@
             "type": "string",
             "description": "GPR project file (*.gpr) for this workspace.\n\nIt is recommended to set this to a relative path starting at the root of the workspace."
         },
+        "gprConfigurationFile": {
+            "type": "string",
+            "default": null,
+            "description": "GPR configuration file (*.cgpr) for this workspace.\n\nIt is recommended to set this to a relative path starting at the root of the workspace."
+        },
         "scenarioVariables": {
             "type": "object",
             "default": {},

source/ada/lsp-ada_client_capabilities.adb

@@ -608,13 +608,20 @@ package body LSP.Ada_Client_Capabilities is
       return GNATCOLL.VFS.Virtual_File
    is
       Value : constant VSS.Strings.Virtual_String := Client.Root;
-      Root  : constant String :=
-                 VSS.Strings.Conversions.To_UTF_8_String (Value);
    begin
-      return GNATCOLL.VFS.Create_From_UTF8
-               (if Value.Starts_With ("file://")
-                then URIs.Conversions.To_File (Root, True)
+      if Value.Is_Empty then
+         return GNATCOLL.VFS.No_File;
+      else
+         declare
+            Root  : constant String :=
+              VSS.Strings.Conversions.To_UTF_8_String (Value);
+         begin
+            return GNATCOLL.VFS.Create_From_UTF8
+              (if Value.Starts_With ("file://")
+               then URIs.Conversions.To_File (Root, True)
                else Root);
+         end;
+      end if;
    end Root_Directory;
 
 end LSP.Ada_Client_Capabilities;

source/ada/lsp-ada_configurations.adb

@@ -227,6 +227,11 @@ package body LSP.Ada_Configurations is
          then
             Self.Project_File := JSON (Index).String_Value;
 
+         elsif Name = "gprConfigurationFile"
+           and then JSON (Index).Kind = String_Value
+         then
+            Self.GPR_Configuration_File := JSON (Index).String_Value;
+
          elsif Name = "projectDiagnostics"
            and then JSON (Index).Kind = Boolean_Value
          then

source/ada/lsp-ada_configurations.ads

@@ -60,6 +60,10 @@ package LSP.Ada_Configurations is
      (Self : Configuration'Class) return VSS.Strings.Virtual_String;
    --  The project file, if provided by the user on Configuration/Init
 
+   function GPR_Configuration_File
+     (Self : Configuration'Class) return VSS.Strings.Virtual_String;
+   --  The configuration file, if provided by the user on Configuration/Init
+
    function Charset
      (Self : Configuration'Class) return VSS.Strings.Virtual_String;
    --  A character set for Libadalang
@@ -149,6 +153,7 @@ private
 
    type Configuration is tagged record
       Project_File                : VSS.Strings.Virtual_String;
+      GPR_Configuration_File      : VSS.Strings.Virtual_String;
       Charset                     : VSS.Strings.Virtual_String;
       Relocate_Build_Tree         : VSS.Strings.Virtual_String;
       Relocate_Root               : VSS.Strings.Virtual_String;
@@ -182,6 +187,10 @@ private
      (Self : Configuration'Class) return VSS.Strings.Virtual_String is
        (Self.Project_File);
 
+   function GPR_Configuration_File
+     (Self : Configuration'Class) return VSS.Strings.Virtual_String is
+       (Self.GPR_Configuration_File);
+
    function Charset
      (Self : Configuration'Class) return VSS.Strings.Virtual_String is
        (Self.Charset);

source/ada/lsp-ada_handlers-project_loading.adb

@@ -77,11 +77,12 @@ package body LSP.Ada_Handlers.Project_Loading is
    LF : VSS.Characters.Virtual_Character renames VSS.Characters.Latin.Line_Feed;
 
    procedure Load_Project
-     (Self         : in out Message_Handler'Class;
-      Project_Path : VSS.Strings.Virtual_String;
-      Context      : GPR2.Context.Object;
-      Environment  : GPR2.Environment.Object;
-      Charset      : VSS.Strings.Virtual_String);
+     (Self            : in out Message_Handler'Class;
+      Project_Path    : VSS.Strings.Virtual_String;
+      GPR_Config_Path : VSS.Strings.Virtual_String;
+      Context         : GPR2.Context.Object;
+      Environment     : GPR2.Environment.Object;
+      Charset         : VSS.Strings.Virtual_String);
    --  Attempt to load the given project file, with the scenario provided.
    --  This unloads all currently loaded project contexts. This factorizes code
    --  between Load_Project_With_Alire and Ensure_Project_Loaded.
@@ -149,7 +150,10 @@ package body LSP.Ada_Handlers.Project_Loading is
       use type VSS.Strings.Virtual_String;
 
       GPRs_Found   : Natural := 0;
-      Project_File : VSS.Strings.Virtual_String := Self.Configuration.Project_File;
+      Project_File : VSS.Strings.Virtual_String :=
+        Self.Configuration.Project_File;
+      GPR_Configuration_File : VSS.Strings.Virtual_String :=
+        Self.Configuration.GPR_Configuration_File;
       Is_Alire_Crate : constant Boolean := Alire.Is_Alire_Crate (Self.Client);
       Has_Alire : Boolean;
       Alire_Errors : VSS.Strings.Virtual_String;
@@ -276,12 +280,21 @@ package body LSP.Ada_Handlers.Project_Loading is
                end if;
             end if;
 
+            if GPR_Configuration_File.Starts_With ("file://") then
+               GPR_Configuration_File :=
+                 VSS.Strings.Conversions.To_Virtual_String
+                   (URIs.Conversions.To_File
+                      (VSS.Strings.Conversions.To_UTF_8_String
+                         (GPR_Configuration_File), True));
+            end if;
+
             Load_Project
-              (Self         => Self,
-               Project_Path => Project_File,
-               Context      => Self.Configuration.Context,
-               Environment  => Environment,
-               Charset      => Charset);
+              (Self            => Self,
+               Project_Path    => Project_File,
+               GPR_Config_Path => GPR_Configuration_File,
+               Context         => Self.Configuration.Context,
+               Environment     => Environment,
+               Charset         => Charset);
          end;
       else
          --  We didn't find a project file. Let's load an implicit project. We
@@ -328,11 +341,13 @@ package body LSP.Ada_Handlers.Project_Loading is
    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);
+      Root   : GNATCOLL.VFS.Virtual_File;
    begin
       Tracer.Trace
         ("Loading the implicit project because " & Status'Image);
@@ -362,8 +377,9 @@ package body LSP.Ada_Handlers.Project_Loading is
       --  When there is no .gpr, create a project which loads the
       --  root directory in the workspace.
 
-      if not Self.Client.Root.Is_Empty then
-         Self.Project_Dirs_Loaded.Include (Self.Client.Root_Directory);
+      Root := Self.Client.Root_Directory;
+      if Root /= GNATCOLL.VFS.No_File then
+         Self.Project_Dirs_Loaded.Include (Root);
       end if;
 
       Reload_Implicit_Project_Dirs (Self);
@@ -384,17 +400,23 @@ package body LSP.Ada_Handlers.Project_Loading is
    ------------------
 
    procedure Load_Project
-     (Self         : in out Message_Handler'Class;
-      Project_Path : VSS.Strings.Virtual_String;
-      Context      : GPR2.Context.Object;
-      Environment  : GPR2.Environment.Object;
-      Charset      : VSS.Strings.Virtual_String)
+     (Self            : in out Message_Handler'Class;
+      Project_Path    : VSS.Strings.Virtual_String;
+      GPR_Config_Path : VSS.Strings.Virtual_String;
+      Context         : GPR2.Context.Object;
+      Environment     : GPR2.Environment.Object;
+      Charset         : VSS.Strings.Virtual_String)
    is
       use type VSS.Strings.Virtual_String;
+      use type GNATCOLL.VFS.Virtual_File;
 
-      Project_File : GNATCOLL.VFS.Virtual_File :=
+      Project_File    : GNATCOLL.VFS.Virtual_File :=
         LSP.Utils.To_Virtual_File (Project_Path);
 
+      GPR_Config_File : GNATCOLL.VFS.Virtual_File;
+
+      Root            : GNATCOLL.VFS.Virtual_File;
+
       procedure Create_Context_For_Non_Aggregate
         (View : GPR2.Project.View.Object);
       --  Create a new context for the given project view.
@@ -504,11 +526,22 @@ package body LSP.Ada_Handlers.Project_Loading is
       --  relative path; if so, we're assuming it's relative
       --  to Self.Root.
 
+      Root := Self.Client.Root_Directory;
+
       if not Project_File.Is_Absolute_Path
-        and then not Self.Client.Root.Is_Empty
+        and then Root /= GNATCOLL.VFS.No_File
       then
-         Project_File := GNATCOLL.VFS.Join (Self.Client.Root_Directory,
-                                            Project_File);
+         Project_File := GNATCOLL.VFS.Join (Root, Project_File);
+      end if;
+
+      if not GPR_Config_Path.Is_Empty then
+         GPR_Config_File := LSP.Utils.To_Virtual_File (GPR_Config_Path);
+
+         if not GPR_Config_File.Is_Absolute_Path
+           and then Root /= GNATCOLL.VFS.No_File
+         then
+            GPR_Config_File := GNATCOLL.VFS.Join (Root, GPR_Config_File);
+         end if;
       end if;
 
       --  Unload the project tree and the project environment
@@ -540,6 +573,12 @@ package body LSP.Ada_Handlers.Project_Loading is
       begin
          --  Load the project
          Opts.Add_Switch (GPR2.Options.P, Project_File.Display_Full_Name);
+
+         if GPR_Config_File /= GNATCOLL.VFS.No_File then
+            Opts.Add_Switch
+              (GPR2.Options.Config, GPR_Config_File.Display_Full_Name);
+         end if;
+
          Opts.Add_Context (Context);
 
          Tracer.Trace ("Loading project with GPR2");

testsuite/ada_lsp/config_file/main.adb

@@ -0,0 +1,8 @@
+
+with Ada.Characters.Latin_1;
+
+procedure Main is
+   Char : Character := Ada.Characters.Latin_1.BEL;
+begin
+   null;
+end Main;

testsuite/ada_lsp/config_file/main.gpr

@@ -0,0 +1,7 @@
+project Main is
+
+   for Languages use ("Ada");
+   for Source_Dirs use (".");
+   for Main use ("main.adb");
+
+end Main;

testsuite/ada_lsp/config_file/main1.gpr

@@ -0,0 +1,7 @@
+project Main1 is
+
+   for Languages use ("Ada");
+   for Source_Dirs use (".");
+   for Main use ("main.adb");
+
+end Main1;

testsuite/ada_lsp/config_file/test.py

@@ -0,0 +1,65 @@
+"""
+The goal of this test is to check that we take in account
+configurationFile configuration option and have proper navigation
+"""
+
+import subprocess
+from drivers.pylsp import (
+    ALSLanguageClient,
+    URI,
+    didOpenTextDocumentParams,
+    assertEqual,
+    test,
+)
+from lsprotocol.types import (
+    DeclarationParams,
+    TextDocumentIdentifier,
+    Position,
+    Location,
+)
+
+# create default.cgpr configuration file that will use sjlj runtime
+subprocess.check_call(["gprconfig", "--batch", "--config=Ada,,sjlj,,GNAT"])
+
+
+@test()
+async def do_testing(lsp: ALSLanguageClient) -> None:
+    # Set configuration file
+    lsp.didChangeConfig(
+        {"projectFile": URI("main.gpr"), "gprConfigurationFile": URI("default.cgpr")}
+    )
+    await lsp.awaitIndexingEnd()
+
+    # Send a didOpen for main.adb
+    open_params, main_adb_uri = didOpenTextDocumentParams("main.adb")
+    lsp.text_document_did_open(open_params)
+
+    # Send `goto declaration` request
+    result = await lsp.text_document_declaration_async(
+        DeclarationParams(TextDocumentIdentifier(main_adb_uri), Position(4, 48))
+    )
+
+    # Check result
+    assert result
+    assert isinstance(result, Location)
+    assertEqual("sjlj" in result.uri, True)
+
+    # Check relative to root paths
+    lsp.didChangeConfig(
+        {"projectFile": "main1.gpr", "gprConfigurationFile": "default.cgpr"}
+    )
+    await lsp.awaitIndexingEnd()
+
+    # Send a didOpen for main.adb
+    open_params, main_adb_uri = didOpenTextDocumentParams("main.adb")
+    lsp.text_document_did_open(open_params)
+
+    # Send `goto declaration` request
+    result = await lsp.text_document_declaration_async(
+        DeclarationParams(TextDocumentIdentifier(main_adb_uri), Position(4, 48))
+    )
+
+    # Check result
+    assert result
+    assert isinstance(result, Location)
+    assertEqual("sjlj" in result.uri, True)

testsuite/ada_lsp/config_file/test.yaml

@@ -0,0 +1 @@
+driver: pylsp

testsuite/drivers/pylsp.py

@@ -232,6 +232,7 @@ class ALSSettings(
     onTypeFormatting: OnTypeFormattingSetting | None
     projectDiagnostics: bool | None
     projectFile: str | None
+    gprConfigurationFile: str | None
     relocateBuildTree: str | None
     renameInComments: bool | None
     rootDir: str | None