Skip to content

Commit 98c4407

Browse files
author
automatic-merge
committed
Merge remote branch 'origin/master' into edge
2 parents b7306d9 + abbdd3c commit 98c4407

File tree

18 files changed

+844
-629
lines changed

18 files changed

+844
-629
lines changed

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

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

18+
with GPR2.Source_Reference;
19+
with GPR2.Message;
20+
with GPR2.Path_Name;
21+
1822
with VSS.Strings;
1923

2024
with LSP.Enumerations;
25+
with LSP.Utils;
2126

2227
package body LSP.Ada_Handlers.Project_Diagnostics is
2328

24-
Single_Project_Found_Message : constant VSS.Strings.Virtual_String :=
25-
VSS.Strings.To_Virtual_String
26-
("Unique project in root directory was found and " &
27-
"loaded, but it wasn't explicitly configured.");
28-
29-
No_Runtime_Found_Message : constant VSS.Strings.Virtual_String :=
30-
VSS.Strings.To_Virtual_String
31-
("The project was loaded, but no Ada runtime found. " &
32-
"Please check the installation of the Ada compiler.");
33-
34-
No_Project_Found_Message : constant VSS.Strings.Virtual_String :=
35-
VSS.Strings.To_Virtual_String
36-
("No project found in root directory. " &
37-
"Please create a project file and add it to the configuration.");
29+
Project_Loading_Status_Messages : constant array (Load_Project_Status)
30+
of VSS.Strings.Virtual_String :=
31+
(Single_Project_Found =>
32+
VSS.Strings.To_Virtual_String
33+
("Unique project in root directory was found and "
34+
& "loaded, but it wasn't explicitly configured."),
35+
No_Runtime_Found =>
36+
VSS.Strings.To_Virtual_String
37+
("The project was loaded, but no Ada runtime found. "
38+
& "Please check the installation of the Ada compiler."),
39+
No_Project_Found =>
40+
VSS.Strings.To_Virtual_String
41+
("No project found in root directory. "
42+
& "Please create a project file and add it to the "
43+
& "configuration."),
44+
Multiple_Projects_Found =>
45+
VSS.Strings.To_Virtual_String
46+
("No project was loaded, because more than one "
47+
& "project file has been found in the root directory. "
48+
& "Please change configuration to point a correct project "
49+
& "file."),
50+
Invalid_Project_Configured =>
51+
VSS.Strings.To_Virtual_String
52+
("Project file has errors and can't be loaded."),
53+
others => VSS.Strings.Empty_Virtual_String);
54+
-- The diagnostics' messages depending on the project loading status.
3855

39-
Multiple_Projects_Found_Message : constant VSS.Strings.Virtual_String :=
40-
VSS.Strings.To_Virtual_String
41-
("No project was loaded, because more than one project file has been " &
42-
"found in the root directory. Please change configuration to point " &
43-
"a correct project file.");
44-
45-
Invalid_Project_Configured_Message : constant VSS.Strings.Virtual_String :=
46-
VSS.Strings.To_Virtual_String
47-
("Project file has error and can't be loaded.");
56+
Project_Loading_Status_Severities : constant array (Load_Project_Status)
57+
of LSP.Enumerations.DiagnosticSeverity :=
58+
(Valid_Project_Configured => LSP.Enumerations.Hint,
59+
Alire_Project => LSP.Enumerations.Hint,
60+
Single_Project_Found => LSP.Enumerations.Hint,
61+
No_Runtime_Found => LSP.Enumerations.Warning,
62+
Multiple_Projects_Found => LSP.Enumerations.Error,
63+
No_Project_Found => LSP.Enumerations.Error,
64+
Invalid_Project_Configured => LSP.Enumerations.Error);
65+
-- The diagnostics' severities depending on the project loading status.
4866

4967
--------------------
5068
-- Get_Diagnostic --
@@ -55,33 +73,124 @@ package body LSP.Ada_Handlers.Project_Diagnostics is
5573
Context : LSP.Ada_Contexts.Context;
5674
Errors : out LSP.Structures.Diagnostic_Vector)
5775
is
58-
Item : LSP.Structures.Diagnostic;
76+
use LSP.Structures;
77+
78+
Parent_Diagnostic : LSP.Structures.Diagnostic;
79+
GPR2_Messages : GPR2.Log.Object renames
80+
Self.Handler.Project_Status.GPR2_Messages;
81+
82+
procedure Create_Project_Loading_Diagnostic;
83+
-- Create a parent diagnostic for the project loading status.
84+
85+
procedure Append_GPR2_Diagnostics;
86+
-- Append the GPR2 messages to the given parent diagnostic, if any.
87+
88+
---------------------------------------
89+
-- Create_Project_Loading_Diagnostic --
90+
---------------------------------------
91+
92+
procedure Create_Project_Loading_Diagnostic is
93+
Sloc : constant LSP.Structures.A_Range :=
94+
(start => (0, 0),
95+
an_end => (0, 0));
96+
begin
97+
-- Initialize the parent diagnostic.
98+
Parent_Diagnostic.a_range := ((0, 0), (0, 0));
99+
Parent_Diagnostic.source := "project";
100+
Parent_Diagnostic.severity :=
101+
(True, Project_Loading_Status_Severities (Self.Last_Status));
102+
103+
-- If we don't have any GPR2 messages, display the project loading
104+
-- status message in the parent diagnostic directly.
105+
-- Otherwise display a generic message in the parent amnd append it
106+
-- to its children, along with the other GPR2 messages.
107+
if GPR2_Messages.Is_Empty then
108+
Parent_Diagnostic.message := Project_Loading_Status_Messages
109+
(Self.Last_Status);
110+
else
111+
declare
112+
Project_File : GNATCOLL.VFS.Virtual_File renames
113+
Self.Handler.Project_Status.Project_File;
114+
URI : constant LSP.Structures.DocumentUri :=
115+
Self.Handler.To_URI
116+
(Project_File.Display_Full_Name);
117+
begin
118+
Parent_Diagnostic.message := "Project Problems";
119+
Parent_Diagnostic.relatedInformation.Append
120+
(LSP.Structures.DiagnosticRelatedInformation'
121+
(location =>
122+
LSP.Structures.Location'
123+
(uri => URI, a_range => Sloc,
124+
others => <>),
125+
message =>
126+
Project_Loading_Status_Messages
127+
(Self.Last_Status)));
128+
end;
129+
end if;
130+
end Create_Project_Loading_Diagnostic;
131+
132+
-----------------------------
133+
-- Append_GPR2_Diagnostics --
134+
-----------------------------
135+
136+
procedure Append_GPR2_Diagnostics is
137+
use GPR2.Message;
138+
use LSP.Enumerations;
139+
begin
140+
for Msg of GPR2_Messages loop
141+
if Msg.Level in GPR2.Message.Warning .. GPR2.Message.Error then
142+
declare
143+
Sloc : constant GPR2.Source_Reference.Object :=
144+
GPR2.Message.Sloc (Msg);
145+
File : constant GPR2.Path_Name.Object :=
146+
(if Sloc.Is_Defined and then Sloc.Has_Source_Reference then
147+
GPR2.Path_Name.Create_File
148+
(GPR2.Filename_Type (Sloc.Filename))
149+
else
150+
Self.Handler.Project_Tree.Root_Path);
151+
begin
152+
Parent_Diagnostic.relatedInformation.Append
153+
(LSP .Structures.DiagnosticRelatedInformation'
154+
(location => LSP.Structures.Location'
155+
(uri => LSP.Utils.To_URI (File),
156+
a_range => LSP.Utils.To_Range (Sloc),
157+
others => <>),
158+
message => VSS.Strings.Conversions.To_Virtual_String
159+
(Msg.Message)));
160+
end;
161+
162+
-- If we have one error in the GPR2 messages, the parent
163+
-- diagnostic's severity should be "error" too, otherwise
164+
-- "warning".
165+
if Msg.Level = GPR2.Message.Error then
166+
Parent_Diagnostic.severity :=
167+
(True, LSP.Enumerations.Error);
168+
elsif Parent_Diagnostic.severity.Value /=
169+
LSP.Enumerations.Error
170+
then
171+
Parent_Diagnostic.severity :=
172+
(True, LSP.Enumerations.Warning);
173+
end if;
174+
end if;
175+
end loop;
176+
end Append_GPR2_Diagnostics;
177+
59178
begin
60-
Self.Last_Status := Self.Handler.Project_Status;
61-
Item.a_range := ((0, 0), (0, 0));
62-
Item.source := "project";
63-
Item.severity := (True, LSP.Enumerations.Error);
64-
65-
case Self.Last_Status is
66-
when Valid_Project_Configured | Alire_Project =>
67-
null;
68-
when No_Runtime_Found =>
69-
Item.message := No_Runtime_Found_Message;
70-
Errors.Append (Item);
71-
when Single_Project_Found =>
72-
Item.message := Single_Project_Found_Message;
73-
Item.severity := (True, LSP.Enumerations.Hint);
74-
Errors.Append (Item);
75-
when No_Project_Found =>
76-
Item.message := No_Project_Found_Message;
77-
Errors.Append (Item);
78-
when Multiple_Projects_Found =>
79-
Item.message := Multiple_Projects_Found_Message;
80-
Errors.Append (Item);
81-
when Invalid_Project_Configured =>
82-
Item.message := Invalid_Project_Configured_Message;
83-
Errors.Append (Item);
84-
end case;
179+
Self.Last_Status := Self.Handler.Project_Status.Load_Status;
180+
181+
-- If we have a valid project return immediately: we want to display
182+
-- diagnostics only if there is an issue to solve or a potential
183+
-- enhancement.
184+
if Self.Last_Status = Valid_Project_Configured
185+
or else (Self.Last_Status = Alire_Project and then GPR2_Messages.Is_Empty)
186+
then
187+
return;
188+
end if;
189+
190+
Create_Project_Loading_Diagnostic;
191+
Append_GPR2_Diagnostics;
192+
193+
Errors.Append (Parent_Diagnostic);
85194
end Get_Diagnostic;
86195

87196
------------------------
@@ -95,7 +204,9 @@ package body LSP.Ada_Handlers.Project_Diagnostics is
95204
is
96205
pragma Unreferenced (Context);
97206
begin
98-
return Self.Last_Status /= Self.Handler.Project_Status;
207+
return
208+
(Self.Last_Status /= Self.Handler.Project_Status.Load_Status
209+
or else not Self.Handler.Project_Status.GPR2_Messages.Is_Empty);
99210
end Has_New_Diagnostic;
100211

101212
end LSP.Ada_Handlers.Project_Diagnostics;

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ private
3939
type Diagnostic_Source
4040
(Handler : not null access LSP.Ada_Handlers.Message_Handler)
4141
is limited new LSP.Diagnostic_Sources.Diagnostic_Source with record
42-
Last_Status : Load_Project_Status := Valid_Project_Configured;
42+
Last_Status : Load_Project_Status := No_Project_Found;
4343
end record;
4444

4545
end LSP.Ada_Handlers.Project_Diagnostics;

0 commit comments

Comments
 (0)