Skip to content

Commit

Permalink
Merge remote branch 'origin/master' into edge
Browse files Browse the repository at this point in the history 
(no-precommit-check no-tn-check)
  • Loading branch information
mergerepo committed Jan 25, 2023
2 parents 3d92029 + 658ba16 commit eb7d6cb
Show file tree
Hide file tree
Showing 11 changed files with 319 additions and 505 deletions.
190 changes: 71 additions & 119 deletions source/ada/lsp-ada_contexts.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,15 +19,10 @@ with Ada.Characters.Handling; use Ada.Characters.Handling;

with GNAT.Strings;

with GNATCOLL.Projects; use GNATCOLL.Projects;
with GNATCOLL.Traces; use GNATCOLL.Traces;
with GNATCOLL.VFS; use GNATCOLL.VFS;

with GPR2.Containers;
with GPR2.Path_Name;
with GPR2.Project.Attribute;
with GPR2.Project.Attribute_Index;
with GPR2.Project.Source;

with VSS.Strings.Conversions;

with URIs;
Expand Down Expand Up @@ -265,7 +260,7 @@ package body LSP.Ada_Contexts is
File : GNATCOLL.VFS.Virtual_File;
Reparse : Boolean := False) return Libadalang.Analysis.Analysis_Unit is
begin
if not Is_Ada_File (Self.Tree.all, File) then
if not Is_Ada_File (Self.Tree, File) then
return Libadalang.Analysis.No_Analysis_Unit;
end if;

Expand Down Expand Up @@ -687,10 +682,10 @@ package body LSP.Ada_Contexts is
------------------

procedure Load_Project
(Self : in out Context;
Tree : GPR2.Project.Tree.Object;
Root : GPR2.Project.View.Object;
Charset : String)
(Self : in out Context;
Tree : not null GNATCOLL.Projects.Project_Tree_Access;
Root : Project_Type;
Charset : String)
is
procedure Update_Source_Files;
-- Update the value of Self.Source_Files
Expand All @@ -702,47 +697,44 @@ package body LSP.Ada_Contexts is
-------------------------

procedure Update_Source_Files is

procedure Insert_Source (Source : GPR2.Project.Source.Object);
-- Insert Source in Self.Source_Files

-------------------
-- Insert_Source --
-------------------

procedure Insert_Source (Source : GPR2.Project.Source.Object) is
Path : constant Virtual_File := Source.Path_Name.Virtual_File;
begin
if not Self.Source_Files.Contains (Path) then
Self.Source_Files.Include (Path);
All_Sources : File_Array_Access :=
Root.Source_Files (Recursive => True);
All_Ada_Sources : File_Array (1 .. All_Sources'Length);
Free_Index : Natural := All_Ada_Sources'First;
begin
-- Iterate through all sources, returning only those that have Ada
-- as language.
for J in All_Sources'Range loop
if Is_Ada_File (Self.Tree, All_Sources (J)) then
All_Ada_Sources (Free_Index) := All_Sources (J);
Free_Index := Free_Index + 1;
end if;
end Insert_Source;
end loop;

begin
Unchecked_Free (All_Sources);
Self.Source_Files.Clear;

Tree.For_Each_Source
(View => Root,
Action => Insert_Source'Access,
Language => GPR2.Ada_Language,
Externally_Built => True);
for Index in 1 .. Free_Index - 1 loop
Self.Source_Files.Include (All_Ada_Sources (Index));
end loop;

Self.Source_Dirs.Clear;
Self.External_Source_Dirs.Clear;

for Dir of Tree.Source_Directories
(View => Root,
Externally_Built => False)
for Dir of Source_Dirs
(Project => Root,
Recursive => True,
Include_Externally_Built => False)
loop
Self.Source_Dirs.Include (Dir.Virtual_File);
Self.Source_Dirs.Include (Dir);
end loop;

Self.External_Source_Dirs.Clear;

for Dir of Tree.Source_Directories
(View => Root,
Externally_Built => True)
for Dir of Source_Dirs
(Project => Root,
Recursive => True,
Include_Externally_Built => True)
loop
Self.External_Source_Dirs.Include (Dir.Virtual_File);
Self.External_Source_Dirs.Include (Dir);
end loop;
end Update_Source_Files;

Expand All @@ -752,45 +744,39 @@ package body LSP.Ada_Contexts is

procedure Pretty_Printer_Setup
is
use type GNAT.Strings.String_Access;
Options : GNAT.Strings.String_List_Access;
Validated : GNAT.Strings.String_List_Access;
Index : Integer := 0;
Attribute : GPR2.Project.Attribute.Object;
Values : GPR2.Containers.Value_List;
Last : Integer;
Default : Boolean;
begin
Root.Switches
(In_Pkg => "Pretty_Printer",
File => GNATCOLL.VFS.No_File,
Language => "ada",
Value => Options,
Is_Default_Value => Default);

-- Initialize an gnatpp command line object
Last := Options'First - 1;
for Item of Options.all loop
if Item /= null
and then Item.all /= ""
then
Last := Last + 1;
end if;
end loop;

if Root.Check_Attribute
(Name => LSP.Common.Pretty_Printer.Switches,
Index => LSP.Common.Ada_Index,
Result => Attribute)
then

-- Fill 'Values' with non empty value

for Value of Attribute.Values loop
declare
Text : constant String := Value.Text;
begin
if Text /= "" then
Values.Append (Text);
Index := Index + 1;
end if;
end;
end loop;

Validated := new GNAT.Strings.String_List (1 .. Index);

if Index > 0 then
Index := Validated'First;
for Text of Values loop
Validated (Index) := new String'(Text);
Index := Index + 1;
end loop;
Validated := new GNAT.Strings.String_List (Options'First .. Last);
Last := Options'First - 1;
for Item of Options.all loop
if Item /= null
and then Item.all /= ""
then
Last := Last + 1;
Validated (Last) := new String'(Item.all);
end if;
else
Validated := new GNAT.Strings.String_List (1 .. 0);
end if;
end loop;

Utils.Command_Lines.Parse
(Validated,
Expand All @@ -800,21 +786,24 @@ package body LSP.Ada_Contexts is
Collect_File_Names => False,
Ignore_Errors => True);

GNAT.Strings.Free (Options);
GNAT.Strings.Free (Validated);

-- Set UTF-8 encoding
Utils.Command_Lines.Common.Set_WCEM (Self.PP_Options, "8");
end Pretty_Printer_Setup;

begin
Self.Id := VSS.Strings.Conversions.To_Virtual_String
(String (Root.Name));
Self.Tree := Tree.Reference;
Self.Id := VSS.Strings.Conversions.To_Virtual_String (Root.Name);
Self.Tree := Tree;
Self.Charset := Ada.Strings.Unbounded.To_Unbounded_String (Charset);

Self.Unit_Provider :=
Libadalang.Project_Provider.Create_Project_Unit_Provider
(Tree => Tree, Project => Root);
(Tree => Tree,
Project => Root,
Env => Get_Environment (Root),
Is_Project_Owner => False);

Self.Event_Handler := Libadalang.Analysis.Create_Event_Handler_Reference
(LSP_Context_Event_Handler_Type'(Trace => Self.Trace));
Expand Down Expand Up @@ -1174,49 +1163,12 @@ package body LSP.Ada_Contexts is

function Project_Attribute_Value
(Self : Context;
Attribute : GPR2.Q_Attribute_Id;
Attribute : Attribute_Pkg_String;
Index : String := "";
Default : String := "";
Use_Extended : Boolean := False) return String
is
Attribute_Index : constant GPR2.Project.Attribute_Index.Object :=
(if Index = ""
then GPR2.Project.Attribute_Index.Undefined
else GPR2.Project.Attribute_Index.Create (Index));

Attribute_Value : GPR2.Project.Attribute.Object;

begin
if Self.Tree.Root_Project.Check_Attribute
(Name => Attribute,
Index => Attribute_Index,
Result => Attribute_Value)
then
return Attribute_Value.Value.Text;
elsif Use_Extended and then Self.Tree.Root_Project.Is_Extending then
-- Look at Extended project list as attribute not found in
-- Root_Project and Use_Extended requested.

declare
Extended_Root : GPR2.Project.View.Object :=
Self.Tree.Root_Project.Extended_Root;
begin
while Extended_Root.Is_Defined loop
if Extended_Root.Check_Attribute
(Name => Attribute,
Index => Attribute_Index,
Result => Attribute_Value)
then
return Attribute_Value.Value.Text;
elsif Extended_Root.Is_Extending then
Extended_Root := Extended_Root.Extended_Root;
else
Extended_Root := GPR2.Project.View.Undefined;
end if;
end loop;
end;
end if;
return Default;
end Project_Attribute_Value;
is (if Self.Tree = null then Default
else Root_Project (Self.Tree.all).
Attribute_Value (Attribute, Index, Default, Use_Extended));

end LSP.Ada_Contexts;
16 changes: 7 additions & 9 deletions source/ada/lsp-ada_contexts.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,14 +20,12 @@
with Ada.Strings.Unbounded;
with Ada.Strings.UTF_Encoding;

with GNATCOLL.Projects;
with GNATCOLL.Traces;
with GNATCOLL.VFS;

with GNATdoc.Comments.Options;

with GPR2.Project.Tree;
with GPR2.Project.View;

with Langkit_Support.File_Readers; use Langkit_Support.File_Readers;
with Laltools.Common;

Expand Down Expand Up @@ -66,10 +64,10 @@ package LSP.Ada_Contexts is
-- in particular.

procedure Load_Project
(Self : in out Context;
Tree : GPR2.Project.Tree.Object;
Root : GPR2.Project.View.Object;
Charset : String);
(Self : in out Context;
Tree : not null GNATCOLL.Projects.Project_Tree_Access;
Root : GNATCOLL.Projects.Project_Type;
Charset : String);
-- Use the given project tree, and root project within this project
-- tree, as project for this context. Root must be a non-aggregate
-- project tree representing the root of a hierarchy inside Tree.
Expand Down Expand Up @@ -311,7 +309,7 @@ package LSP.Ada_Contexts is

function Project_Attribute_Value
(Self : Context;
Attribute : GPR2.Q_Attribute_Id;
Attribute : GNATCOLL.Projects.Attribute_Pkg_String;
Index : String := "";
Default : String := "";
Use_Extended : Boolean := False) return String;
Expand Down Expand Up @@ -340,7 +338,7 @@ private
-- Indicate that this is a "fallback" context, ie the context
-- holding any file, in the case no valid project was loaded.

Tree : access GPR2.Project.Tree.Object;
Tree : GNATCOLL.Projects.Project_Tree_Access;
-- The loaded project tree: we need to keep a reference to this
-- in order to figure out which files are Ada and which are not.
-- Do not deallocate: this is owned by the Message_Handler.
Expand Down
50 changes: 2 additions & 48 deletions source/ada/lsp-ada_handlers-other_file_commands.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,10 +17,6 @@

with Ada.Strings.UTF_Encoding;

with GNATCOLL.Tribooleans;

with GPR2.Project.Source;

with LSP.Messages.Client_Requests;

with VSS.Strings.Conversions;
Expand Down Expand Up @@ -78,50 +74,8 @@ package body LSP.Ada_Handlers.Other_File_Commands is
File : constant GNATCOLL.VFS.Virtual_File :=
Message_Handler.To_File (Self.URI);

function Other_File return GNATCOLL.VFS.Virtual_File;

----------------
-- Other_File --
----------------

function Other_File return GNATCOLL.VFS.Virtual_File is
F : constant GPR2.Path_Name.Object := GPR2.Path_Name.Create (File);
begin
for V in Message_Handler.Project_Tree.Iterate
(Status => (GPR2.Project.S_Externally_Built =>
GNATCOLL.Tribooleans.Indeterminate))
loop
declare
Source : constant GPR2.Project.Source.Object :=
GPR2.Project.Tree.Element (V).Source (F);
Other_Part : GPR2.Project.Source.Source_Part;
begin
if Source.Is_Defined then
Other_Part := Source.Other_Part_Unchecked (GPR2.No_Index);
if Other_Part.Source.Is_Defined then
return Other_Part.Source.Path_Name.Virtual_File;
end if;
end if;
end;
end loop;

if Message_Handler.Project_Tree.Has_Runtime_Project then
declare
Source : constant GPR2.Project.Source.Object :=
Message_Handler.Project_Tree.Runtime_Project.
Source (F);
Other_Part : GPR2.Project.Source.Source_Part;
begin
if Source.Is_Defined then
Other_Part := Source.Other_Part_Unchecked (GPR2.No_Index);
if Other_Part.Source.Is_Defined then
return Other_Part.Source.Path_Name.Virtual_File;
end if;
end if;
end;
end if;
return File;
end Other_File;
Other_File : constant GNATCOLL.VFS.Virtual_File :=
Message_Handler.Project_Tree.Other_File (File);

URI : constant LSP.Messages.DocumentUri :=
Message_Handler.From_File (Other_File);
Expand Down
Loading

0 comments on commit eb7d6cb

Please sign in to comment.