Add a 'als-get-project-attribute-value' command

Used to query project attribute values from LSP clients.

For eng/ide/ada_language_server#1309

Author: AnthonyLeonardoGracio

doc/get_project_attribute_value.md

@@ -0,0 +1,31 @@
+# Get Project Attribute Value
+
+## Short introduction
+
+This is a custom command used by the VS Code extension to retrieve the value of a project attribute for the
+currently loaded project tree.
+
+## Change description
+
+The command's name is the following:
+
+  method: `als-get-project-attribute-value`
+
+With the following arguments:
+
+```typescript
+
+type ProjectAttributeValueArgs = {
+   attribute: string, /* The name of the attribute (e.g: 'Main') */
+   pkg: string="", /* The name of the package (e.g: 'Compiler'). Can be empty for top-level attributes */
+   index: string="" /* Index for indexed attributes (e.g: 'Ada' in 'for Default_Switches ("Ada") use ..') */,
+}
+```
+
+with the associated return type:
+
+```typescript
+
+type ProjectValueResponse = string | string[];
+
+```

integration/vscode/ada/src/ExtensionState.ts

@@ -1,5 +1,10 @@
 import * as vscode from 'vscode';
-import { Disposable, ExecuteCommandRequest, LanguageClient } from 'vscode-languageclient/node';
+import {
+    Disposable,
+    ExecuteCommandParams,
+    ExecuteCommandRequest,
+    LanguageClient,
+} from 'vscode-languageclient/node';
 import { AdaCodeLensProvider } from './AdaCodeLensProvider';
 import { createClient } from './clients';
 import { AdaInitialDebugConfigProvider, initializeDebugging } from './debugConfigProvider';
@@ -183,6 +188,42 @@ export class ExtensionState {
         }
     };
 
+    /**
+     * Returns the value of the given project attribute, or raises
+     * an exception when the queried attribute is not known
+     * (i.e: not registered in GPR2's knowledge database).
+     *
+     * @param attribute - The name of the project attribute (e.g: 'Target')
+     * @param pkg - The name of the attribute's package (e.g: 'Compiler').
+     * Can be empty for project-level attributes.
+     * @param index - Attribute's index, if any. Can be a file or a language
+     * (e.g: 'for Runtime ("Ada") use...').
+     * @returns the value of the queried project attribute. Can be either a string or a
+     * list of strings, depending on the attribute itself (e.g: 'Main' attribute is
+     * specified as a list of strings while 'Target' as a string)
+     */
+    public async getProjectAttributeValue(
+        attribute: string,
+        pkg: string = '',
+        index: string = '',
+    ): Promise<string | string[]> {
+        const params: ExecuteCommandParams = {
+            command: 'als-get-project-attribute-value',
+            arguments: [
+                {
+                    attribute: attribute,
+                    pkg: pkg,
+                    index: index,
+                },
+            ],
+        };
+
+        const attrValue = (await this.adaClient.sendRequest(ExecuteCommandRequest.type, params)) as
+            | string
+            | string[];
+        return attrValue;
+    }
+
     /**
      * @returns the URI of the main project file from the ALS
      */

integration/vscode/ada/test/general/helpers.test.ts

@@ -2,6 +2,7 @@ import assert from 'assert';
 import { envHasExec, findAdaMain, getSymbols, which } from '../../src/helpers';
 import { DocumentSymbol, SymbolKind, Uri, commands, workspace } from 'vscode';
 import { rangeToStr } from '../utils';
+import { adaExtState } from '../../src/extension';
 
 suite('which and envHasExec', function () {
     test('existing', function () {
@@ -51,6 +52,31 @@ suite('findAdaMain', function () {
     });
 });
 
+suite('getProjectAttributeValue', function () {
+    test('Get project attribute value (simple case)', async function () {
+        /* Basic test for getProjectAttributeValue */
+        const switches = await adaExtState.getProjectAttributeValue(
+            'Default_Switches',
+            'Compiler',
+            'Ada',
+        );
+        assert.deepEqual(switches, ['-g', '-O0']);
+    });
+
+    test('Get unknown project attribute value', async function () {
+        /* Check that we get an exception when trying to get the value
+        of an unknown attribute */
+
+        let error = undefined;
+        try {
+            await adaExtState.getProjectAttributeValue('Unknown');
+        } catch (e) {
+            error = e;
+        }
+        assert.notEqual(error, undefined);
+    });
+});
+
 suite('getSymbols', function () {
     let symbols: DocumentSymbol[];
 

source/ada/lsp-ada_contexts.adb

@@ -27,6 +27,7 @@ with GPR2.Containers;
 with GPR2.Path_Name;
 with GPR2.Project.Attribute;
 with GPR2.Project.Attribute_Index;
+with GPR2.Project.Registry.Attribute;
 with GPR2.Build.Source;
 with GPR2.Build.Source.Sets;
 
@@ -925,73 +926,105 @@ package body LSP.Ada_Contexts is
       return Ada.Strings.Unbounded.To_String (Self.Charset);
    end Charset;
 
+   ------------------------------
+   -- Project_Attribute_Values --
+   ------------------------------
+
+   function Project_Attribute_Values
+     (View              : GPR2.Project.View.Object;
+      Attribute         : GPR2.Q_Attribute_Id;
+      Index             : String := "";
+      Is_List_Attribute : out Boolean;
+      Is_Known          : out Boolean)
+      return VSS.String_Vectors.Virtual_String_Vector
+   is
+      use GPR2.Project.Registry.Attribute;
+
+      Attribute_Index : constant GPR2.Project.Attribute_Index.Object :=
+        (if Index = "" then GPR2.Project.Attribute_Index.Undefined
+         else GPR2.Project.Attribute_Index.Create (Index));
+
+      Attribute_Value : GPR2.Project.Attribute.Object;
+
+      function Convert
+        (Values : GPR2.Containers.Source_Value_List)
+         return VSS.String_Vectors.Virtual_String_Vector;
+
+      -------------
+      -- Convert --
+      -------------
+
+      function Convert
+        (Values : GPR2.Containers.Source_Value_List)
+         return VSS.String_Vectors.Virtual_String_Vector
+      is
+         Result : VSS.String_Vectors.Virtual_String_Vector;
+      begin
+         for Value of Values loop
+            Result.Append (VSS.Strings.Conversions.To_Virtual_String (Value.Text));
+         end loop;
+
+         return Result;
+      end Convert;
+
+   begin
+      Is_Known := False;
+
+      if View.Check_Attribute
+           (Name   => Attribute,
+            Index  => Attribute_Index,
+            Result => Attribute_Value)
+      then
+         Is_List_Attribute := (Attribute_Value.Kind = List);
+         Is_Known := True;
+         return Convert (Attribute_Value.Values);
+      end if;
+
+      return [];
+   end Project_Attribute_Values;
+
    -----------------------------
    -- Project_Attribute_Value --
    -----------------------------
 
    function Project_Attribute_Value
-     (Self         : Context;
+     (View         : GPR2.Project.View.Object;
       Attribute    : GPR2.Q_Attribute_Id;
       Index        : String := "";
-      Default      : String := "";
-      Use_Extended : Boolean := False) return String is
+      Default      : String := "") return String
+   is
+      Dummy      : Boolean;
+      Is_Known   : Boolean;
+      Values : constant VSS.String_Vectors.Virtual_String_Vector :=
+        Project_Attribute_Values
+          (View              => View,
+           Attribute         => Attribute,
+           Index             => Index,
+           Is_List_Attribute => Dummy,
+           Is_Known          => Is_Known);
    begin
-      return Project_Attribute_Value
-        (View         => Self.Tree.Root_Project,
-         Attribute    => Attribute,
-         Index        => Index,
-         Default      => Default,
-         Use_Extended => Use_Extended);
+      if Is_Known then
+         return VSS.Strings.Conversions.To_UTF_8_String (Values.First_Element);
+      else
+         return Default;
+      end if;
    end Project_Attribute_Value;
 
    -----------------------------
    -- Project_Attribute_Value --
    -----------------------------
 
    function Project_Attribute_Value
-     (View         : GPR2.Project.View.Object;
+     (Self         : Context;
       Attribute    : GPR2.Q_Attribute_Id;
       Index        : String := "";
-      Default      : String := "";
-      Use_Extended : Boolean := False) return String is
-      Attribute_Index : constant GPR2.Project.Attribute_Index.Object :=
-        (if Index = ""
-         then GPR2.Project.Attribute_Index.Undefined
-         else GPR2.Project.Attribute_Index.Create (Index));
-
-      Attribute_Value : GPR2.Project.Attribute.Object;
-
+      Default      : String := "") return String is
    begin
-      if View.Check_Attribute
-        (Name   => Attribute,
-         Index  => Attribute_Index,
-         Result => Attribute_Value)
-      then
-         return Attribute_Value.Value.Text;
-      elsif Use_Extended and then View.Is_Extending then
-         --  Look at Extended project list as attribute not found in
-         --  Root_Project and Use_Extended requested.
-
-         declare
-            Extended_Root : GPR2.Project.View.Object :=
-              View.Extended_Root;
-         begin
-            while Extended_Root.Is_Defined loop
-               if Extended_Root.Check_Attribute
-                 (Name   => Attribute,
-                  Index  => Attribute_Index,
-                  Result => Attribute_Value)
-               then
-                  return Attribute_Value.Value.Text;
-               elsif Extended_Root.Is_Extending then
-                  Extended_Root := Extended_Root.Extended_Root;
-               else
-                  Extended_Root := GPR2.Project.View.Undefined;
-               end if;
-            end loop;
-         end;
-      end if;
-      return Default;
+      return Project_Attribute_Value
+        (View         => Self.Tree.Root_Project,
+         Attribute    => Attribute,
+         Index        => Index,
+         Default      => Default);
    end Project_Attribute_Value;
 
 end LSP.Ada_Contexts;

source/ada/lsp-ada_contexts.ads

@@ -37,6 +37,7 @@ with Libadalang.Common;
 with Utils.Command_Lines;
 with Pp.Command_Lines;
 
+with VSS.String_Vectors;
 with VSS.Strings;
 
 with LSP.Ada_Documents;
@@ -275,32 +276,57 @@ package LSP.Ada_Contexts is
    function Charset (Self : Context) return String;
    --  Return the charset for this context
 
+   function Project_Attribute_Values
+     (View              : GPR2.Project.View.Object;
+      Attribute         : GPR2.Q_Attribute_Id;
+      Index             : String := "";
+      Is_List_Attribute : out Boolean;
+      Is_Known          : out Boolean)
+      return VSS.String_Vectors.Virtual_String_Vector;
+   --  Returns the values for the given project attribute.
+   --  The corresponding attribute would have been set in the project as:
+   --      for Attribute use "value";
+   --      for Attribute use ("value_1", "value_2");
+   --  or
+   --      for Attribute (Index) use "value";
+   --      for Attribute (Index) use ("value_1", "value_2");
+   --
+   --  If the attribute is not defined in the project itself, then the
+   --  attribute is looked up in the project extended by the project (if
+   --  any).
+   --  A default value will always be returned if the attribute is known.
+   --  Is_List_Attribute will be set to True if the queried attribute is a
+   --  string list attribute (e.g: for Main use ("main1.adb", "main2.adb"))
+   --  or set to False if it's a simple string one
+   --  (e.g: for Target use "arm-eabi");
+   --  Is_Known will be set to False if the attribute is not known (i.e: not
+   --  registered in GPR2's knowledge database).
+
    function Project_Attribute_Value
-     (Self         : Context;
+     (View         : GPR2.Project.View.Object;
       Attribute    : GPR2.Q_Attribute_Id;
       Index        : String := "";
-      Default      : String := "";
-      Use_Extended : Boolean := False) return String;
-   --  Returns the value for Self's project Attribute.
+      Default      : String := "") return String;
+   --  Returns the value for the given string project Attribute.
    --  Default is returned if the attribute wasn't set by the user and
    --  has no default value.
    --  The corresponding attribute would have been set in the project as:
    --      for Attribute use "value";
    --  or
    --      for Attribute (Index) use "value";
    --
-   --  If Use_Extended is True and the attribute is not defined in Project
-   --  itself, then the attribute is looked up in the project extended by
-   --  Project (if any).
+   --  If the given attribute corresponds to a string list attribute instead
+   --  (e.g: 'Main' attribute, which takes a list of mains) of a simple string
+   --  attribute, the first value of the list is returned: if you want to get
+   --  the full list use the Project_Attribute_Values function instead.
 
    function Project_Attribute_Value
-     (View         : GPR2.Project.View.Object;
+     (Self         : Context;
       Attribute    : GPR2.Q_Attribute_Id;
       Index        : String := "";
-      Default      : String := "";
-      Use_Extended : Boolean := False) return String;
-   --  Same as above, but computing the value from the given view instead
-   --  of the context's root project.
+      Default      : String := "") return String;
+   --  Same as above, but computing the value directly from the context's
+   --  root project view.
 
 private
 

source/ada/lsp-ada_driver.adb

@@ -60,6 +60,7 @@ with LSP.Ada_Handlers.Named_Parameters_Commands;
 with LSP.Ada_Handlers.Object_Dir_Commands;
 with LSP.Ada_Handlers.Other_File_Commands;
 with LSP.Ada_Handlers.Open_Project_File_Commands;
+with LSP.Ada_Handlers.Project_Attributes_Commands;
 with LSP.Ada_Handlers.Project_File_Commands;
 with LSP.Ada_Handlers.Project_Reload_Commands;
 with LSP.Ada_Handlers.Refactor.Add_Parameter;
@@ -197,6 +198,8 @@ procedure LSP.Ada_Driver is
         (LSP.Ada_Handlers.Executables_Commands.Command'Tag);
       LSP.Ada_Commands.Register
         (LSP.Ada_Handlers.Mains_Commands.Command'Tag);
+      LSP.Ada_Commands.Register
+        (LSP.Ada_Handlers.Project_Attributes_Commands.Command'Tag);
       LSP.Ada_Commands.Register
         (LSP.Ada_Handlers.Project_File_Commands.Command'Tag);
       LSP.Ada_Commands.Register