Skip to content

Commit 1492ee3

Browse files
committed
Merge branch 'topic/default-config-file' into 'master'
Factorize the logic for deciding if a project reload is needed Closes #1554 See merge request eng/ide/ada_language_server!1842
2 parents ccde5ff + 5fffa91 commit 1492ee3

File tree

5 files changed

+183
-91
lines changed

5 files changed

+183
-91
lines changed

source/ada/lsp-ada_configurations.adb

Lines changed: 137 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -22,16 +22,23 @@ with Ada.Containers.Generic_Anonymous_Array_Sort;
2222
with GNATCOLL.Traces;
2323
with GNATCOLL.VFS;
2424

25+
with LSP.GNATCOLL_Tracers;
2526
with LSP.Utils;
2627

2728
with VSS.JSON.Pull_Readers.Simple;
2829
with VSS.JSON.Streams;
2930
with VSS.Strings.Conversions;
31+
with VSS.Strings.Formatters.Booleans;
32+
with VSS.Strings.Formatters.Strings;
33+
with VSS.Strings.Templates;
3034
with VSS.Text_Streams.File_Input;
3135
with VSS.Transformers.Casing;
3236

3337
package body LSP.Ada_Configurations is
3438

39+
Trace : constant LSP.GNATCOLL_Tracers.Tracer :=
40+
LSP.GNATCOLL_Tracers.Create ("ALS.CONFIG", GNATCOLL.Traces.Off);
41+
3542
Doc_Style_Values : constant VSS.String_Vectors.Virtual_String_Vector :=
3643
[for Item in GNATdoc.Comments.Options.Documentation_Style =>
3744
VSS.Strings.To_Virtual_String (Item'Wide_Wide_Image).Transform
@@ -71,8 +78,7 @@ package body LSP.Ada_Configurations is
7178
procedure Parse_Ada
7279
(Self : in out Configuration'Class;
7380
JSON : LSP.Structures.LSPAny;
74-
From : Positive;
75-
Reload : out Boolean);
81+
From : Positive);
7682

7783
----------------
7884
-- Build_Path --
@@ -136,26 +142,18 @@ package body LSP.Ada_Configurations is
136142
procedure Parse_Ada
137143
(Self : in out Configuration'Class;
138144
JSON : LSP.Structures.LSPAny;
139-
From : Positive;
140-
Reload : out Boolean)
145+
From : Positive)
141146
is
142147
use all type VSS.JSON.JSON_Number_Kind;
143148
use all type VSS.JSON.Streams.JSON_Stream_Element_Kind;
144-
use type VSS.String_Vectors.Virtual_String_Vector;
145149

146150
Index : Positive := From;
147151
Variables_Names : VSS.String_Vectors.Virtual_String_Vector;
148152
Variables_Values : VSS.String_Vectors.Virtual_String_Vector;
149-
Follow_Symlinks : constant Boolean := Self.Follow_Symlinks;
150153

151154
procedure Parse_Variables (From : Positive);
152155
procedure Swap_Variables (Left, Right : Positive);
153156

154-
procedure Set
155-
(Target : in out VSS.Strings.Virtual_String;
156-
Value : VSS.Strings.Virtual_String);
157-
-- If Target /= Value then assign Target and set Reload to Trues
158-
159157
---------------------
160158
-- Parse_Variables --
161159
---------------------
@@ -181,20 +179,6 @@ package body LSP.Ada_Configurations is
181179
end loop;
182180
end Parse_Variables;
183181

184-
---------
185-
-- Set --
186-
---------
187-
188-
procedure Set
189-
(Target : in out VSS.Strings.Virtual_String;
190-
Value : VSS.Strings.Virtual_String) is
191-
begin
192-
if Target /= Value then
193-
Target := Value;
194-
Reload := True;
195-
end if;
196-
end Set;
197-
198182
--------------------
199183
-- Swap_Variables --
200184
--------------------
@@ -220,7 +204,6 @@ package body LSP.Ada_Configurations is
220204

221205
Name : VSS.Strings.Virtual_String;
222206
begin
223-
Reload := False;
224207
Index := Index + 1; -- skip start object
225208

226209
while Index <= JSON.Last_Index
@@ -232,17 +215,17 @@ package body LSP.Ada_Configurations is
232215
if Name = "relocateBuildTree"
233216
and then JSON (Index).Kind = String_Value
234217
then
235-
Set (Self.Relocate_Build_Tree, JSON (Index).String_Value);
218+
Self.Relocate_Build_Tree := JSON (Index).String_Value;
236219

237220
elsif Name = "rootDir"
238221
and then JSON (Index).Kind = String_Value
239222
then
240-
Set (Self.Relocate_Root, JSON (Index).String_Value);
223+
Self.Relocate_Root := JSON (Index).String_Value;
241224

242225
elsif Name = "projectFile"
243226
and then JSON (Index).Kind = String_Value
244227
then
245-
Set (Self.Project_File, JSON (Index).String_Value);
228+
Self.Project_File := JSON (Index).String_Value;
246229

247230
elsif Name = "projectDiagnostics"
248231
and then JSON (Index).Kind = Boolean_Value
@@ -255,10 +238,6 @@ package body LSP.Ada_Configurations is
255238
Parse_Variables (Index);
256239
Sort_Variables (1, Variables_Names.Length);
257240

258-
Reload := Reload or else
259-
Variables_Names /= Self.Variables_Names or else
260-
Variables_Values /= Self.Variables_Values;
261-
262241
Self.Variables_Names := Variables_Names;
263242
Self.Variables_Values := Variables_Values;
264243

@@ -276,7 +255,7 @@ package body LSP.Ada_Configurations is
276255
elsif Name = "defaultCharset"
277256
and then JSON (Index).Kind = String_Value
278257
then
279-
Set (Self.Charset, JSON (Index).String_Value);
258+
Self.Charset := JSON (Index).String_Value;
280259

281260
elsif Name = "enableDiagnostics"
282261
and then JSON (Index).Kind = Boolean_Value
@@ -318,7 +297,6 @@ package body LSP.Ada_Configurations is
318297
and then JSON (Index).Kind = Boolean_Value
319298
then
320299
Self.Follow_Symlinks := JSON (Index).Boolean_Value;
321-
Reload := Reload or else Follow_Symlinks /= Self.Follow_Symlinks;
322300

323301
elsif Name = "documentationStyle"
324302
and then JSON (Index).Kind = String_Value
@@ -403,7 +381,6 @@ package body LSP.Ada_Configurations is
403381
Input : aliased VSS.Text_Streams.File_Input.File_Input_Text_Stream;
404382
Reader : VSS.JSON.Pull_Readers.Simple.JSON_Simple_Pull_Reader;
405383
JSON : LSP.Structures.LSPAny;
406-
Ignore : Boolean;
407384
begin
408385
Input.Open (File, "utf-8");
409386
Reader.Set_Stream (Input'Unchecked_Access);
@@ -416,7 +393,7 @@ package body LSP.Ada_Configurations is
416393
Reader.Read_Next;
417394
end loop;
418395

419-
Self.Parse_Ada (JSON, JSON.First_Index, Ignore);
396+
Self.Parse_Ada (JSON, JSON.First_Index);
420397
end Read_File;
421398

422399
---------------
@@ -425,32 +402,27 @@ package body LSP.Ada_Configurations is
425402

426403
procedure Read_JSON
427404
(Self : in out Configuration'Class;
428-
JSON : LSP.Structures.LSPAny;
429-
Reload : out Boolean)
405+
JSON : LSP.Structures.LSPAny)
430406
is
431407
use all type VSS.JSON.Streams.JSON_Stream_Element_Kind;
432408
Index : Positive := JSON.First_Index + 1;
433409

434410
begin
435-
Reload := False;
436-
437411
if JSON.Is_Empty or else JSON.First_Element.Kind /= Start_Object then
438412
return;
439413
end if;
440414

441-
while Index < JSON.Last_Index
442-
and then JSON (Index).Kind = Key_Name
415+
while Index < JSON.Last_Index and then JSON (Index).Kind = Key_Name
443416
loop
444417
declare
445418
Is_Ada : constant Boolean := JSON (Index).Key_Name = "ada";
446419
begin
447420
Index := Index + 1;
448421

449-
if Is_Ada and then
450-
Index <= JSON.Last_Index and then
451-
JSON (Index).Kind = Start_Object
422+
if Is_Ada and then Index <= JSON.Last_Index
423+
and then JSON (Index).Kind = Start_Object
452424
then
453-
Self.Parse_Ada (JSON, Index, Reload);
425+
Self.Parse_Ada (JSON, Index);
454426
exit;
455427
else
456428
Skip_Value (JSON, Index);
@@ -483,4 +455,122 @@ package body LSP.Ada_Configurations is
483455
end loop;
484456
end Skip_Value;
485457

458+
function Diff
459+
(Old, Nnew : VSS.Strings.Virtual_String;
460+
Setting_Name : VSS.Strings.Virtual_String) return Boolean;
461+
-- A setting comparison helper that logs when a difference is detected.
462+
463+
----------
464+
-- Diff --
465+
----------
466+
467+
function Diff
468+
(Old, Nnew : VSS.Strings.Virtual_String;
469+
Setting_Name : VSS.Strings.Virtual_String) return Boolean
470+
is
471+
use VSS.Strings.Formatters.Strings;
472+
begin
473+
if Old /= Nnew then
474+
if Trace.Active then
475+
Trace.Trace_Text
476+
(VSS.Strings.Templates.To_Virtual_String_Template
477+
("Signaling project reload because the setting '{}' changed from '{}' to '{}'")
478+
.Format
479+
(Image (Setting_Name), Image (Old), Image (Nnew)));
480+
end if;
481+
return True;
482+
else
483+
return False;
484+
end if;
485+
end Diff;
486+
487+
function Diff
488+
(Old, Nnew : Boolean; Setting_Name : VSS.Strings.Virtual_String)
489+
return Boolean;
490+
-- A setting comparison helper that logs when a difference is detected.
491+
492+
----------
493+
-- Diff --
494+
----------
495+
496+
function Diff
497+
(Old, Nnew : Boolean; Setting_Name : VSS.Strings.Virtual_String)
498+
return Boolean
499+
is
500+
use VSS.Strings.Formatters.Strings;
501+
use VSS.Strings.Formatters.Booleans;
502+
begin
503+
if Old /= Nnew then
504+
if Trace.Active then
505+
Trace.Trace_Text
506+
(VSS.Strings.Templates.To_Virtual_String_Template
507+
("Signaling project reload because the setting '{}' changed from '{}' to '{}'")
508+
.Format
509+
(Image (Setting_Name), Image (Old), Image (Nnew)));
510+
end if;
511+
return True;
512+
else
513+
return False;
514+
end if;
515+
end Diff;
516+
517+
function Diff
518+
(Old, Nnew : GPR2.Context.Object;
519+
Setting_Name : VSS.Strings.Virtual_String) return Boolean;
520+
-- A setting comparison helper that logs when a difference is detected.
521+
522+
----------
523+
-- Diff --
524+
----------
525+
526+
function Diff
527+
(Old, Nnew : GPR2.Context.Object;
528+
Setting_Name : VSS.Strings.Virtual_String) return Boolean
529+
is
530+
use VSS.Strings.Formatters.Strings;
531+
use type GPR2.Context.Object;
532+
begin
533+
if Old /= Nnew then
534+
if Trace.Active then
535+
Trace.Trace_Text
536+
(VSS.Strings.Templates.To_Virtual_String_Template
537+
("Signaling project reload because the setting '{}' changed")
538+
.Format
539+
(Image (Setting_Name)));
540+
end if;
541+
return True;
542+
else
543+
return False;
544+
end if;
545+
end Diff;
546+
547+
------------------
548+
-- Needs_Reload --
549+
------------------
550+
551+
function Needs_Reload
552+
(Self : Configuration; Other : Configuration'Class) return Boolean
553+
is
554+
Reload : Boolean := False;
555+
begin
556+
Reload :=
557+
Diff
558+
(Self.Relocate_Build_Tree, Other.Relocate_Build_Tree,
559+
"relocateBuildTree")
560+
or else Diff
561+
(Self.Relocate_Root, Other.Relocate_Root, "rootDir")
562+
or else Diff (Self.Project_File, Other.Project_File, "projectFile")
563+
or else Diff (Self.Context, Other.Context, "scenarioVariables")
564+
or else Diff (Self.Charset, Other.Charset, "defaultCharset")
565+
or else Diff
566+
(Self.Follow_Symlinks, Other.Follow_Symlinks, "followSymlinks");
567+
568+
if not Reload and then Trace.Active then
569+
Trace.Trace
570+
("No change in configuration that warrants a project reload.");
571+
end if;
572+
573+
return Reload;
574+
end Needs_Reload;
575+
486576
end LSP.Ada_Configurations;

source/ada/lsp-ada_configurations.ads

Lines changed: 16 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -31,10 +31,23 @@ package LSP.Ada_Configurations is
3131

3232
type Configuration is tagged private;
3333

34+
function Needs_Reload
35+
(Self : Configuration; Other : Configuration'Class) return Boolean;
36+
-- Compare the given configurations and return whether or not a project
37+
-- reload is needed.
38+
--
39+
-- For example, if the 'projectFile' setting changed, a project reload is
40+
-- needed while if the 'insertWithClauses' setting changed, a project
41+
-- reload is not necessary.
42+
--
43+
-- Note that for the 'scenarioVariables' settings, the comparison is made
44+
-- using the "=" operator of the GPR2.Context.Object object which does an
45+
-- order-insensitive comparison. That means that a simple change in the
46+
-- order of scenario variables doesn't trigger a reload, which is nice.
47+
3448
procedure Read_JSON
3549
(Self : in out Configuration'Class;
36-
JSON : LSP.Structures.LSPAny;
37-
Reload : out Boolean);
50+
JSON : LSP.Structures.LSPAny);
3851

3952
procedure Read_File
4053
(Self : in out Configuration'Class;
@@ -125,7 +138,7 @@ package LSP.Ada_Configurations is
125138
-- Whether onTypeFormatting is enabled.
126139

127140
function On_Type_Formatting_Settings
128-
return LSP.Structures.DocumentOnTypeFormattingOptions;
141+
return LSP.Structures.DocumentOnTypeFormattingOptions;
129142

130143
private
131144

0 commit comments

Comments
 (0)