Skip to content

Commit 49a248a

Browse files
AnthonyLeonardoGracioAnthonyLeonardoGracio
committed
Merge branch 'topic/#1637' into 'master'
Better handling of aggregate projects in various commands See merge request eng/ide/ada_language_server!2026
2 parents d6ae187 + 2c33d7a commit 49a248a

File tree

18 files changed

+465
-40
lines changed

18 files changed

+465
-40
lines changed

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

Lines changed: 39 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@
1818
with Ada.Containers.Indefinite_Vectors;
1919
with GPR2.Project.View;
2020

21+
with GPR2.Project.View.Set;
2122
with VSS.JSON.Streams;
2223

2324
package body LSP.Ada_Handlers.Mains_Commands is
@@ -47,6 +48,9 @@ package body LSP.Ada_Handlers.Mains_Commands is
4748
Response : in out LSP.Structures.LSPAny_Or_Null;
4849
Error : in out LSP.Errors.ResponseError_Optional)
4950
is
51+
function Get_Main_Paths
52+
(Views : GPR2.Project.View.Set.Object) return Main_Vectors.Vector;
53+
5054
procedure Append (Item : VSS.JSON.Streams.JSON_Stream_Element);
5155

5256
------------
@@ -58,28 +62,47 @@ package body LSP.Ada_Handlers.Mains_Commands is
5862
Response.Value.Append (Item);
5963
end Append;
6064

61-
Element : GPR2.Project.View.Object;
65+
--------------------
66+
-- Get_Main_Paths --
67+
--------------------
68+
69+
function Get_Main_Paths
70+
(Views : GPR2.Project.View.Set.Object) return Main_Vectors.Vector
71+
is
72+
Main_Paths : Main_Vectors.Vector;
73+
begin
74+
for View of Views loop
75+
if View.Has_Mains then
76+
for Main of View.Mains loop
77+
declare
78+
Main_Path : constant String := String (Main.Source.Value);
79+
begin
80+
-- Avoid duplicates coming from GPR2
81+
-- Workaround for eng/ide/gpr-issues#417
82+
if not Main_Paths.Contains (Main_Path) then
83+
Main_Paths.Append (Main_Path);
84+
end if;
85+
end;
86+
end loop;
87+
end if;
88+
end loop;
89+
90+
return Main_Paths;
91+
end Get_Main_Paths;
92+
93+
Views : GPR2.Project.View.Set.Object;
6294
Main_Paths : Main_Vectors.Vector;
6395
begin
6496
Response := (Is_Null => False, Value => <>);
6597
Append ((Kind => VSS.JSON.Streams.Start_Array));
6698

99+
-- If the project was correctly loaded, iterate over each
100+
-- subtree to get their list of mains.
101+
-- This is needed to handle aggregate projects: we want to
102+
-- combine the mains of each aggregated project in this case.
67103
if Handler.Project_Tree.Is_Defined then
68-
Element := Handler.Project_Tree.Root_Project;
69-
70-
if Element.Has_Mains then
71-
for Main of Element.Mains loop
72-
declare
73-
Main_Path : constant String := String (Main.Source.Value);
74-
begin
75-
-- Avoid duplicates coming from GPR2
76-
-- Workaround for eng/ide/gpr-issues#417
77-
if not Main_Paths.Contains (Main_Path) then
78-
Main_Paths.Append (Main_Path);
79-
end if;
80-
end;
81-
end loop;
82-
end if;
104+
Views := Handler.Project_Tree.Namespace_Root_Projects;
105+
Main_Paths := Get_Main_Paths (Views);
83106
end if;
84107

85108
for Main_Path of Main_Paths loop

‎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;

0 commit comments

Comments
 (0)