Skip to content

Commit 28d927b

Browse files
reznikmmreznikmm
committed
Run alr show and alr printenv in a sequence
instead of as concurrent processes. Fixes ada_language_server#1339, refs #1192 on github
1 parent 5b57e54 commit 28d927b

File tree

1 file changed

+132
-88
lines changed

1 file changed

+132
-88
lines changed

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

Lines changed: 132 additions & 88 deletions
Original file line numberDiff line numberDiff line change
@@ -52,11 +52,15 @@ package body LSP.Ada_Handlers.Alire is
5252
Error : Integer);
5353

5454
procedure Start_Alire
55-
(Listener : in out Process_Listener'Class;
56-
ALR : String;
55+
(ALR : String;
5756
Option_1 : String;
5857
Option_2 : String;
59-
Root : String);
58+
Root : String;
59+
Error : out VSS.Strings.Virtual_String;
60+
Lines : out VSS.String_Vectors.Virtual_String_Vector);
61+
62+
Anchored : constant VSS.Regular_Expressions.Match_Options :=
63+
(VSS.Regular_Expressions.Anchored_Match => True);
6064

6165
--------------------
6266
-- Error_Occurred --
@@ -81,10 +85,6 @@ package body LSP.Ada_Handlers.Alire is
8185
Environment : in out GPR2.Environment.Object)
8286
is
8387
use type GNAT.OS_Lib.String_Access;
84-
use type Spawn.Process_Exit_Code;
85-
use type Spawn.Process_Exit_Status;
86-
use type Spawn.Process_Status;
87-
use all type VSS.Regular_Expressions.Match_Option;
8888

8989
ALR : GNAT.OS_Lib.String_Access :=
9090
GNAT.OS_Lib.Locate_Exec_On_Path ("alr");
@@ -100,13 +100,7 @@ package body LSP.Ada_Handlers.Alire is
100100
VSS.Regular_Expressions.To_Regular_Expression
101101
("export ([^=]+)=""([^\n]+)""");
102102

103-
Anchored : constant VSS.Regular_Expressions.Match_Options :=
104-
(VSS.Regular_Expressions.Anchored_Match => True);
105-
106-
List : array (1 .. 2) of aliased Process_Listener;
107103
Lines : VSS.String_Vectors.Virtual_String_Vector;
108-
Text : VSS.Strings.Virtual_String;
109-
Decoder : VSS.Strings.Converters.Decoders.Virtual_String_Decoder;
110104
begin
111105
Project.Clear;
112106
Has_Alire := ALR /= null;
@@ -116,67 +110,14 @@ package body LSP.Ada_Handlers.Alire is
116110
return;
117111
end if;
118112

119-
Start_Alire (List (1), ALR.all, "--non-interactive", "show", Root);
120-
Start_Alire (List (2), ALR.all, "--non-interactive", "printenv", Root);
113+
Start_Alire (ALR.all, "--non-interactive", "show", Root, Error, Lines);
121114

122-
loop
123-
Spawn.Processes.Monitor_Loop (0.1);
124-
125-
exit when
126-
(for all Item of List => Item.Process.Status = Spawn.Not_Running);
127-
end loop;
128-
129-
Decoder.Initialize ("utf-8");
130-
GNAT.OS_Lib.Free (ALR);
131-
132-
-- Decode output and check errors
133-
for Item of List loop
134-
Decoder.Reset_State;
135-
Item.Text := Decoder.Decode (Item.Stdout);
136-
137-
if Item.Process.Exit_Status /= Spawn.Normal
138-
or else Item.Process.Exit_Code /= 0
139-
or else Decoder.Has_Error
140-
or else Item.Error /= 0
141-
then
142-
Error := "'alr";
143-
144-
for Arg of Item.Process.Arguments loop
145-
Error.Append (" ");
146-
Error.Append (VSS.Strings.Conversions.To_Virtual_String (Arg));
147-
end loop;
148-
149-
Error.Append ("' failed:");
150-
Error.Append (VSS.Characters.Latin.Line_Feed);
151-
152-
if Decoder.Has_Error then
153-
Error.Append (Decoder.Error_Message);
154-
else
155-
Error.Append (Item.Text);
156-
end if;
157-
158-
Error.Append (VSS.Characters.Latin.Line_Feed);
159-
Decoder.Reset_State;
160-
Text := Decoder.Decode (Item.Stderr);
161-
162-
if Decoder.Has_Error then
163-
Error.Append (Decoder.Error_Message);
164-
else
165-
Error.Append (Text);
166-
end if;
167-
168-
if Item.Error /= 0 then
169-
Error.Append
170-
(VSS.Strings.Conversions.To_Virtual_String
171-
(GNAT.OS_Lib.Errno_Message (Item.Error)));
172-
end if;
173-
174-
return;
175-
end if;
176-
end loop;
115+
if not Error.Is_Empty then
116+
GNAT.OS_Lib.Free (ALR);
117+
return;
118+
end if;
177119

178120
-- Find project file in `alr show` output
179-
Lines := List (1).Text.Split_Lines;
180121

181122
declare
182123
First : constant VSS.Strings.Virtual_String := Lines (1);
@@ -202,8 +143,18 @@ package body LSP.Ada_Handlers.Alire is
202143
end;
203144
end loop;
204145

146+
if Project.Is_Empty then
147+
Error.Append ("No project file is found by alire");
148+
end if;
149+
150+
-- Find variables in `alr printenv` output
151+
152+
Start_Alire
153+
(ALR.all, "--non-interactive", "printenv", Root, Error, Lines);
154+
155+
GNAT.OS_Lib.Free (ALR);
156+
205157
-- Find variables in `alr printenv` output
206-
Lines := List (2).Text.Split_Lines;
207158

208159
for Line of Lines loop
209160
declare
@@ -219,10 +170,6 @@ package body LSP.Ada_Handlers.Alire is
219170
end if;
220171
end;
221172
end loop;
222-
223-
if Project.Is_Empty then
224-
Error.Append ("No project file is found by alire");
225-
end if;
226173
end Run_Alire;
227174

228175
---------------
@@ -235,33 +182,130 @@ package body LSP.Ada_Handlers.Alire is
235182
Error : out VSS.Strings.Virtual_String;
236183
Environment : in out GPR2.Environment.Object)
237184
is
238-
Ignore : VSS.Strings.Virtual_String;
185+
use type GNAT.OS_Lib.String_Access;
186+
187+
ALR : GNAT.OS_Lib.String_Access :=
188+
GNAT.OS_Lib.Locate_Exec_On_Path ("alr");
189+
190+
Export_Pattern : constant VSS.Regular_Expressions.Regular_Expression :=
191+
VSS.Regular_Expressions.To_Regular_Expression
192+
("export ([^=]+)=""([^\n]+)""");
193+
194+
Lines : VSS.String_Vectors.Virtual_String_Vector;
239195
begin
240-
-- TODO: optimization: don't run second alire process
241-
Run_Alire (Root, Has_Alire, Error, Ignore, Environment);
196+
Has_Alire := ALR /= null;
197+
198+
if ALR = null then
199+
Error := "No alr in the PATH";
200+
return;
201+
end if;
202+
203+
Start_Alire
204+
(ALR.all, "--non-interactive", "printenv", Root, Error, Lines);
205+
206+
GNAT.OS_Lib.Free (ALR);
207+
208+
-- Find variables in `alr printenv` output
209+
210+
for Line of Lines loop
211+
declare
212+
Match : constant VSS.Regular_Expressions.Regular_Expression_Match
213+
:= Export_Pattern.Match (Line, Anchored);
214+
begin
215+
if Match.Has_Match then
216+
Environment.Insert
217+
(Key => VSS.Strings.Conversions.To_UTF_8_String
218+
(Match.Captured (1)),
219+
Value => VSS.Strings.Conversions.To_UTF_8_String
220+
(Match.Captured (2)));
221+
end if;
222+
end;
223+
end loop;
242224
end Run_Alire;
243225

244-
-------------------
245-
-- Spawn_Process --
246-
-------------------
226+
-----------------
227+
-- Start_Alire --
228+
-----------------
247229

248230
procedure Start_Alire
249-
(Listener : in out Process_Listener'Class;
250-
ALR : String;
231+
(ALR : String;
251232
Option_1 : String;
252233
Option_2 : String;
253-
Root : String)
234+
Root : String;
235+
Error : out VSS.Strings.Virtual_String;
236+
Lines : out VSS.String_Vectors.Virtual_String_Vector)
254237
is
255-
Process : Spawn.Processes.Process renames Listener.Process;
256-
Options : Spawn.String_Vectors.UTF_8_String_Vector;
238+
use type Spawn.Process_Exit_Code;
239+
use type Spawn.Process_Exit_Status;
240+
use type Spawn.Process_Status;
241+
242+
Item : aliased Process_Listener;
243+
Process : Spawn.Processes.Process renames Item.Process;
244+
Options : Spawn.String_Vectors.UTF_8_String_Vector;
245+
Decoder : VSS.Strings.Converters.Decoders.Virtual_String_Decoder;
246+
Text : VSS.Strings.Virtual_String;
257247
begin
258248
Options.Append (Option_1);
259249
Options.Append (Option_2);
260250
Process.Set_Arguments (Options);
261251
Process.Set_Working_Directory (Root);
262252
Process.Set_Program (ALR);
263-
Process.Set_Listener (Listener'Unchecked_Access);
253+
Process.Set_Listener (Item'Unchecked_Access);
264254
Process.Start;
255+
256+
loop
257+
Spawn.Processes.Monitor_Loop (0.1);
258+
259+
exit when Item.Process.Status = Spawn.Not_Running;
260+
end loop;
261+
262+
Decoder.Initialize ("utf-8");
263+
264+
-- Decode output and check errors
265+
Decoder.Reset_State;
266+
Item.Text := Decoder.Decode (Item.Stdout);
267+
268+
if Item.Process.Exit_Status = Spawn.Normal
269+
and then Item.Process.Exit_Code = 0
270+
and then not Decoder.Has_Error
271+
and then Item.Error = 0
272+
then
273+
274+
Lines := Item.Text.Split_Lines;
275+
276+
else
277+
Error := "'alr";
278+
279+
for Arg of Item.Process.Arguments loop
280+
Error.Append (" ");
281+
Error.Append (VSS.Strings.Conversions.To_Virtual_String (Arg));
282+
end loop;
283+
284+
Error.Append ("' failed:");
285+
Error.Append (VSS.Characters.Latin.Line_Feed);
286+
287+
if Decoder.Has_Error then
288+
Error.Append (Decoder.Error_Message);
289+
else
290+
Error.Append (Item.Text);
291+
end if;
292+
293+
Error.Append (VSS.Characters.Latin.Line_Feed);
294+
Decoder.Reset_State;
295+
Text := Decoder.Decode (Item.Stderr);
296+
297+
if Decoder.Has_Error then
298+
Error.Append (Decoder.Error_Message);
299+
else
300+
Error.Append (Text);
301+
end if;
302+
303+
if Item.Error /= 0 then
304+
Error.Append
305+
(VSS.Strings.Conversions.To_Virtual_String
306+
(GNAT.OS_Lib.Errno_Message (Item.Error)));
307+
end if;
308+
end if;
265309
end Start_Alire;
266310

267311
------------------------------

0 commit comments

Comments
 (0)