Skip to content

Commit 54ecf2e

Browse files
AnthonyLeonardoGracioAnthonyLeonardoGracio
committed
Handle aggregate projects in 'als-get-project-attribute-value' command
By aggregating the proejct attribute's values coming from the aggregated projects when it makes sense (i.e: when the attribute can't be defined in the aggregate root project, but only in the aggregated ones). Add a test for this. For eng/ide/ada_language_server#1637
1 parent d6ae187 commit 54ecf2e

File tree

9 files changed

+294
-24
lines changed

9 files changed

+294
-24
lines changed

‎source/ada/lsp-ada_handlers-project_attributes_commands.adb

Lines changed: 110 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -15,21 +15,54 @@
1515
-- of the license. --
1616
------------------------------------------------------------------------------
1717

18-
with GPR2; use GPR2;
18+
with Ada.Containers.Hashed_Sets;
19+
20+
with GPR2; use GPR2;
21+
with GPR2.Project.Registry.Attribute; use GPR2.Project.Registry.Attribute;
22+
with VSS.Strings.Hash;
1923
with VSS.String_Vectors;
2024
with VSS.JSON.Streams;
2125
with LSP.Enumerations;
22-
with LSP.Structures.LSPAny_Vectors; use LSP.Structures.LSPAny_Vectors;
26+
with LSP.Structures.LSPAny_Vectors; use LSP.Structures.LSPAny_Vectors;
2327

2428
package body LSP.Ada_Handlers.Project_Attributes_Commands is
2529

30+
package Virtual_String_Sets is new Ada.Containers.Hashed_Sets
31+
(VSS.Strings.Virtual_String,
32+
VSS.Strings.Hash,
33+
VSS.Strings."=",
34+
VSS.Strings."=");
35+
36+
-- List of project attributes that should not be defined in
37+
-- agggegate projects, but only in aggregated projects.
38+
-- This list comes from the GPRbuild user's guide
39+
-- (2.8.5. Syntax of aggregate projects).
40+
Aggregatable_Attributes :
41+
constant array (Positive range <>) of Q_Attribute_Id :=
42+
[Languages,
43+
Source_Files,
44+
Source_List_File,
45+
Source_Dirs,
46+
Exec_Dir,
47+
Library_Dir,
48+
Library_Name,
49+
Main,
50+
Roots,
51+
Externally_Built,
52+
Inherit_Source_Path,
53+
Excluded_Source_Dirs,
54+
Locally_Removed_Files,
55+
Excluded_Source_Files,
56+
Excluded_Source_List_File,
57+
Interfaces];
58+
2659
------------
2760
-- Create --
2861
------------
2962

30-
overriding function Create
31-
(Any : not null access LSP.Structures.LSPAny_Vector)
32-
return Command
63+
overriding
64+
function Create
65+
(Any : not null access LSP.Structures.LSPAny_Vector) return Command
3366
is
3467
use VSS.JSON.Streams;
3568
use VSS.Strings;
@@ -77,6 +110,9 @@ package body LSP.Ada_Handlers.Project_Attributes_Commands is
77110
Response : in out LSP.Structures.LSPAny_Or_Null;
78111
Error : in out LSP.Errors.ResponseError_Optional)
79112
is
113+
use VSS.Strings;
114+
use VSS.String_Vectors;
115+
80116
procedure Append (Item : VSS.JSON.Streams.JSON_Stream_Element);
81117
-- Append the given item to the JSON response
82118

@@ -89,7 +125,7 @@ package body LSP.Ada_Handlers.Project_Attributes_Commands is
89125
Response.Value.Append (Item);
90126
end Append;
91127

92-
Attr_Id : constant GPR2.Q_Optional_Attribute_Id :=
128+
Attr_Id : constant GPR2.Q_Optional_Attribute_Id :=
93129
(Pack =>
94130
GPR2."+"
95131
(Optional_Name_Type
@@ -98,17 +134,56 @@ package body LSP.Ada_Handlers.Project_Attributes_Commands is
98134
GPR2."+"
99135
(Optional_Name_Type
100136
(VSS.Strings.Conversions.To_UTF_8_String (Self.Attribute))));
101-
Is_List_Attribute : Boolean;
102-
Is_Known : Boolean;
103-
Values : constant VSS.String_Vectors.Virtual_String_Vector :=
104-
LSP.Ada_Contexts.Project_Attribute_Values
105-
(View => Handler.Project_Tree.Root_Project,
106-
Attribute => Attr_Id,
107-
Index =>
108-
VSS.Strings.Conversions.To_UTF_8_String (Self.Index),
109-
Is_List_Attribute => Is_List_Attribute,
110-
Is_Known => Is_Known);
137+
Index : constant String :=
138+
VSS.Strings.Conversions.To_UTF_8_String (Self.Index);
139+
Is_List_Attribute : Boolean;
140+
Is_Known : Boolean;
141+
Should_Aggregate_Values : constant Boolean :=
142+
Handler.Project_Tree.Root_Project.Kind in Aggregate_Kind
143+
and then (for some Attr of Aggregatable_Attributes => Attr = Attr_Id);
144+
Values : VSS.String_Vectors.Virtual_String_Vector := [];
145+
Already_Returned_Values : Virtual_String_Sets.Set := [];
111146
begin
147+
-- In case of aggregate projects and when the project attribute
148+
-- can't be defined in the aggregate root project itself (e.g: 'Main'),
149+
-- iterate over all the aggregated projects to concatenate the
150+
-- values instead.
151+
if Should_Aggregate_Values then
152+
for View of Handler.Project_Tree.Namespace_Root_Projects loop
153+
Values.Append
154+
(LSP.Ada_Contexts.Project_Attribute_Values
155+
(View => View,
156+
Attribute => Attr_Id,
157+
Index => Index,
158+
Is_List_Attribute => Is_List_Attribute,
159+
Is_Known => Is_Known));
160+
161+
-- The queried attribute belongs to the list of all
162+
-- the project attributes that can be aggregated when
163+
-- dealing with a root aggregate project: ensure that GPR2
164+
-- always know it, for each aggregated project.
165+
pragma
166+
Assert
167+
(Is_Known,
168+
VSS.Strings.Conversions.To_UTF_8_String
169+
("'"
170+
& Self.Pkg
171+
& "."
172+
& Self.Attribute
173+
& "'' project attribute is unknown: project attributes "
174+
& "that can be aggregated should always be known by GPR2"));
175+
end loop;
176+
else
177+
Values :=
178+
LSP.Ada_Contexts.Project_Attribute_Values
179+
(View => Handler.Project_Tree.Root_Project,
180+
Attribute => Attr_Id,
181+
Index =>
182+
VSS.Strings.Conversions.To_UTF_8_String (Self.Index),
183+
Is_List_Attribute => Is_List_Attribute,
184+
Is_Known => Is_Known);
185+
end if;
186+
112187
-- Return an error if the attribute is not known.
113188
if not Is_Known then
114189
Error :=
@@ -121,17 +196,31 @@ package body LSP.Ada_Handlers.Project_Attributes_Commands is
121196

122197
Response := (Is_Null => False, Value => <>);
123198

124-
-- Return a list object if we are dealing with a string list attribute,
125-
-- or a string otherwise.
126-
if Is_List_Attribute then
199+
-- Return a list object if we are dealing with a string list attribute
200+
-- or with aggregated values.
201+
-- Return a simple string otherwise.
202+
if Is_List_Attribute or else Should_Aggregate_Values then
127203
Append ((Kind => VSS.JSON.Streams.Start_Array));
204+
128205
for Value of Values loop
129-
Append (Item => (VSS.JSON.Streams.String_Value, Value));
206+
207+
-- Filter any duplicate when dealing with aggregated values
208+
-- since aggregated projects might have the exact same values
209+
-- for a given attribute (e.g: 'Ada' for 'Languages' in
210+
-- all the aggregated projects)
211+
if not Should_Aggregate_Values
212+
or else not Already_Returned_Values.Contains (Value)
213+
then
214+
Append (Item => (VSS.JSON.Streams.String_Value, Value));
215+
end if;
216+
Already_Returned_Values.Include (Value);
130217
end loop;
218+
131219
Append ((Kind => VSS.JSON.Streams.End_Array));
132220
else
133221
Append
134-
(Item => (VSS.JSON.Streams.String_Value, Values.First_Element));
222+
(Item =>
223+
(VSS.JSON.Streams.String_Value, Values.First_Element));
135224
end if;
136225
end Execute;
137226

‎source/ada/lsp-ada_handlers-project_attributes_commands.ads

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -29,9 +29,9 @@ package LSP.Ada_Handlers.Project_Attributes_Commands is
2929
private
3030

3131
type Command is new LSP.Ada_Commands.Command with record
32-
Pkg : VSS.Strings.Virtual_String;
33-
Attribute : VSS.Strings.Virtual_String;
34-
Index : VSS.Strings.Virtual_String;
32+
Pkg : VSS.Strings.Virtual_String;
33+
Attribute : VSS.Strings.Virtual_String;
34+
Index : VSS.Strings.Virtual_String;
3535
end record;
3636

3737
overriding function Create

‎testsuite/ada_lsp/commands.get_project_attribute_value.aggregate/aggr.gpr

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
aggregate project Aggr is
2+
for Project_Files use ("first.gpr", "second.gpr");
3+
for Target use "arm-eabi";
4+
end Aggr;

‎testsuite/ada_lsp/commands.get_project_attribute_value.aggregate/first.gpr

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
project First is
2+
for Main use ("main_1.adb");
3+
end First;

‎testsuite/ada_lsp/commands.get_project_attribute_value.aggregate/main_1.adb

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
procedure Main_1 is
2+
begin
3+
null;
4+
end Main_1;

‎testsuite/ada_lsp/commands.get_project_attribute_value.aggregate/main_2.adb

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
procedure Main_2 is
2+
begin
3+
null;
4+
end Main_2;

‎testsuite/ada_lsp/commands.get_project_attribute_value.aggregate/second.gpr

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
project Second is
2+
for Main use ("main_2.adb");
3+
end Second;

‎testsuite/ada_lsp/commands.get_project_attribute_value.aggregate/test.json

Lines changed: 162 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,162 @@
1+
[
2+
{
3+
"comment": [
4+
"Test for the 'als-get-project-attribute-value' command on aggregate projects. ",
5+
"Check that we aggregate the values coming from the aggregated projects for project attributes ",
6+
"that can't be defined in the aggregate root project"
7+
]
8+
},
9+
{
10+
"start": {
11+
"cmd": ["${ALS}"]
12+
}
13+
},
14+
{
15+
"send": {
16+
"request": {
17+
"jsonrpc": "2.0",
18+
"id": 0,
19+
"method": "initialize",
20+
"params": {
21+
"processId": 1,
22+
"rootUri": "$URI{.}",
23+
"capabilities": {}
24+
}
25+
},
26+
"wait": [
27+
{
28+
"id": 0,
29+
"result": {
30+
"capabilities": {
31+
"textDocumentSync": 2,
32+
"executeCommandProvider": {
33+
"commands": ["<HAS>", "als-get-project-attribute-value"]
34+
}
35+
}
36+
}
37+
}
38+
]
39+
}
40+
},
41+
{
42+
"send": {
43+
"request": {
44+
"jsonrpc": "2.0",
45+
"method": "workspace/didChangeConfiguration",
46+
"params": {
47+
"settings": {
48+
"ada": {
49+
"projectFile": "$URI{aggr.gpr}"
50+
}
51+
}
52+
}
53+
},
54+
"wait": [
55+
{
56+
"jsonrpc": "2.0",
57+
"method": "$/progress",
58+
"params": {
59+
"token": "<ANY>",
60+
"value": {
61+
"kind": "end"
62+
}
63+
}
64+
}
65+
]
66+
}
67+
},
68+
{
69+
"send": {
70+
"request": {
71+
"jsonrpc": "2.0",
72+
"id": "sw1",
73+
"method": "workspace/executeCommand",
74+
"params": {
75+
"command": "als-get-project-attribute-value",
76+
"arguments": [
77+
{
78+
"attribute": "main"
79+
}
80+
]
81+
}
82+
},
83+
"wait": [
84+
{
85+
"id": "sw1",
86+
"jsonrpc": "2.0",
87+
"result": ["main_1.adb", "main_2.adb"]
88+
}
89+
]
90+
}
91+
},
92+
{
93+
"send": {
94+
"request": {
95+
"jsonrpc": "2.0",
96+
"id": "sw3",
97+
"method": "workspace/executeCommand",
98+
"params": {
99+
"command": "als-get-project-attribute-value",
100+
"arguments": [
101+
{
102+
"attribute": "target"
103+
}
104+
]
105+
}
106+
},
107+
"wait": [
108+
{
109+
"jsonrpc": "2.0",
110+
"id": "sw3",
111+
"result": "arm-eabi"
112+
}
113+
]
114+
}
115+
},
116+
{
117+
"send": {
118+
"request": {
119+
"jsonrpc": "2.0",
120+
"id": "sw4",
121+
"method": "workspace/executeCommand",
122+
"params": {
123+
"command": "als-get-project-attribute-value",
124+
"arguments": [
125+
{
126+
"attribute": "languages"
127+
}
128+
]
129+
}
130+
},
131+
"wait": [
132+
{
133+
"jsonrpc": "2.0",
134+
"id": "sw4",
135+
"result": ["Ada"]
136+
}
137+
]
138+
}
139+
},
140+
{
141+
"send": {
142+
"request": {
143+
"jsonrpc": "2.0",
144+
"id": "shutdown",
145+
"method": "shutdown",
146+
"params": null
147+
},
148+
"wait": [{ "id": "shutdown", "result": null }]
149+
}
150+
},
151+
{
152+
"send": {
153+
"request": { "jsonrpc": "2.0", "method": "exit" },
154+
"wait": []
155+
}
156+
},
157+
{
158+
"stop": {
159+
"exit_code": 0
160+
}
161+
}
162+
]

‎testsuite/ada_lsp/commands.get_project_attribute_value.aggregate/test.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
title: 'commands.get_project_attribute_value.aggregate'

0 commit comments

Comments
 (0)