Skip to content

Commit

Permalink
Merge branch 'topic/source_fetch_cleanup' into 'master'
Browse files Browse the repository at this point in the history
Enhance the GNATcheck performance when running without a project file

Closes #312

See merge request eng/libadalang/langkit-query-language!276
  • Loading branch information
HugoGGuerrier committed Aug 7, 2024
2 parents 6b9d840 + 91f856f commit 3ba0f76
Show file tree
Hide file tree
Showing 7 changed files with 62 additions and 186 deletions.
16 changes: 0 additions & 16 deletions lkql_checker/src/gnatcheck-compiler.adb
Original file line number Diff line number Diff line change
Expand Up @@ -1519,22 +1519,6 @@ package body Gnatcheck.Compiler is
end if;
end GPRbuild_Exec;

----------------
-- Gnatls_Exec --
----------------

function Gnatls_Exec return String is
use Ada.Strings.Unbounded;
begin
if Has_Access_To_Codepeer then
return "codepeer-gnatls";
elsif To_String (Target) /= "" then
return To_String (Target) & "-gnatls";
else
return "gnatls";
end if;
end Gnatls_Exec;

-------------------------
-- Set_Compiler_Checks --
-------------------------
Expand Down
3 changes: 0 additions & 3 deletions lkql_checker/src/gnatcheck-compiler.ads
Original file line number Diff line number Diff line change
Expand Up @@ -26,9 +26,6 @@ package Gnatcheck.Compiler is
function GPRbuild_Exec return String;
-- Return the executable name to use in order to spawn a GPRBuild process

function Gnatls_Exec return String;
-- Return the executable name to use in order to spawn a GNATLS process

--------------------------------------------------------
-- Using in GNATCHECK checks performed by the compiler --
--------------------------------------------------------
Expand Down
195 changes: 29 additions & 166 deletions lkql_checker/src/gnatcheck-source_table.adb
Original file line number Diff line number Diff line change
Expand Up @@ -12,20 +12,15 @@ with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;

with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Expect; use GNAT.Expect;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.String_Split; use GNAT.String_Split;
with GNAT.Table;
with GNAT.Task_Lock;

with Gnatcheck.Compiler; use Gnatcheck.Compiler;
with Gnatcheck.Diagnoses; use Gnatcheck.Diagnoses;
with Gnatcheck.Ids; use Gnatcheck.Ids;
with Gnatcheck.Output; use Gnatcheck.Output;
with Gnatcheck.String_Utilities; use Gnatcheck.String_Utilities;

with GNATCOLL.VFS; use GNATCOLL.VFS;

with GPR2.Build.Source;
with GPR2.Path_Name;
with GPR2.Project.Tree;
Expand All @@ -34,7 +29,6 @@ with GPR2.Project.View;
with Langkit_Support.Generic_API.Introspection;

with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Auto_Provider; use Libadalang.Auto_Provider;
with Libadalang.Project_Provider; use Libadalang.Project_Provider;
with Libadalang.Iterators;
with Libadalang.Generic_API; use Libadalang.Generic_API;
Expand Down Expand Up @@ -234,6 +228,9 @@ package body Gnatcheck.Source_Table is
Duplication_Report : Boolean := True;
Status : SF_Status := Waiting)
is
use GPR2;
use GPR2.Project.Tree;

Old_SF : SF_Id;
New_SF : SF_Id;

Expand All @@ -242,63 +239,53 @@ package body Gnatcheck.Source_Table is
First_Idx : Natural;
Last_Idx : Natural;

use GPR2;
use GPR2.Project.Tree;
Root : constant GPR2.Project.View.Object :=
Arg_Project.Tree.Namespace_Root_Projects.First_Element;
Res : constant GPR2.Build.Source.Object :=
Root.View_Db.Visible_Source
(GPR2.Path_Name.Simple_Name (Filename_Type (Fname)));
begin
Free (Full_Source_Name_String);
Free (Short_Source_Name_String);

if Arg_Project.Tree.Is_Defined then
declare
Root : constant GPR2.Project.View.Object :=
Arg_Project.Tree.Namespace_Root_Projects.First_Element;
Res : constant GPR2.Build.Source.Object :=
Root.View_Db.Visible_Source
(GPR2.Path_Name.Simple_Name (Filename_Type (Fname)));
begin
if not Res.Is_Defined then
Free (Short_Source_Name_String);
else
Short_Source_Name_String :=
new String'(Res.Path_Name.String_Value);
end if;
end;
end if;

if Short_Source_Name_String = null then
Warning (Fname & " not found");
if not Res.Is_Defined then
if Is_Regular_File (Fname) then
Warning (Fname & " is not in the analysed project closure (" &
String (Arg_Project.Tree.Root_Project.Name) & ")");
else
Warning (Fname & " not found");
end if;
Missing_File_Detected := True;
return;
else
Full_Source_Name_String := new String'
(Normalize_Pathname
(Short_Source_Name_String.all,
Resolve_Links => False,
Case_Sensitive => True));

Free (Short_Source_Name_String);
Short_Source_Name_String :=
new String'(Res.Path_Name.String_Value);
end if;

Full_Source_Name_String := new String'
(Normalize_Pathname
(Short_Source_Name_String.all,
Resolve_Links => False,
Case_Sensitive => True));
Free (Short_Source_Name_String);

Short_Source_Name_String := new String'(Base_Name (Fname));
Hash_Index := Hash (To_Lower (Short_Source_Name_String.all));

-- Check if we already have a file with the same short name:

if Present (Hash_Table (Hash_Index)) then
Old_SF := File_Find (Full_Source_Name_String.all);

-- Check if we already stored exactly the same file.
if Present (Old_SF) then
-- This means that we have already stored exactly the same file.

if Duplication_Report then
Error (Short_Source_Name_String.all & " duplicated");
end if;

return;

-- Else, look for files with the same name but with a difference path
else
Old_SF := Same_Name_File_Find (Full_Source_Name_String.all);

if Present (Old_SF) then
Error ("more than one version of "
& Short_Source_Name_String.all & " processed");
Expand All @@ -307,7 +294,6 @@ package body Gnatcheck.Source_Table is
end if;

-- If we are here, we have to store the file in the table

Source_File_Table.Append (New_SF_Record);
Last_Arg_Source := Source_File_Table.Last;
New_SF := Last_Arg_Source;
Expand Down Expand Up @@ -1408,134 +1394,11 @@ package body Gnatcheck.Source_Table is
Partition : GPR2_Provider_And_Projects_Array_Access;

function Create_Context return Checker_App.Lkql_Context is
Ctx : Checker_App.Lkql_Context;
Files : File_Array_Access;
Last : Natural := 0;

procedure Add_Runtime_Files;
-- Add to Files all the GNAT native runtime files, if found

-----------------------
-- Add_Runtime_Files --
-----------------------

procedure Add_Runtime_Files is
Gnatls : String_Access := Locate_Exec_On_Path (Gnatls_Exec);
Verbose : aliased String := "-v";
Status : aliased Integer;

begin
if Gnatls = null then
return;
end if;

-- Spawn gnatls -v

declare
use Ada.Directories;

Output : constant String :=
Get_Command_Output (Gnatls.all,
[Verbose'Unchecked_Access],
"", Status'Unchecked_Access, True);
Lines : String_List_Access;
Ada_Include_Path : String_Access;
Found : Boolean := False;

procedure Add_File (Dir : Directory_Entry_Type);
-- Add the given directory entry Dir to Files

--------------
-- Add_File --
--------------

procedure Add_File (Dir : Directory_Entry_Type) is
begin
Last := @ + 1;
Files (Last) := Create (+Full_Name (Dir));
end Add_File;

begin
if Status /= 0 then
Free (Gnatls);
return;
end if;

-- and look for the line containing "adainclude"

for Line of Create (Output, [ASCII.LF, ASCII.CR], Multiple)
loop
Found := Has_Suffix (Line, "adainclude");

if Found then
Ada_Include_Path :=
new String'(Remove_Spaces (Line));
exit;
end if;
end loop;

Free (Lines);

if not Found then
Free (Gnatls);
return;
end if;

-- We then list all the *.ads files.
-- We only need to process spec files, runtime body files are not
-- needed to analyze user code and will slow down the startup
-- phase.

Search (Ada_Include_Path.all, "*.ads",
Process => Add_File'Access);
Free (Ada_Include_Path);
Free (Gnatls);
end;
end Add_Runtime_Files;

Charset : constant String := To_String (Arg.Charset.Get);

Ctx : Checker_App.Lkql_Context;
begin
-- If no project specified, create an auto provider with all the source
-- files listed in the command line, stored in Temporary_File_Storage,
-- as well as all runtime files, these are needed for proper name
-- resolution.

if not Gnatcheck_Prj.Is_Specified then
declare
procedure Add_File (File_Name : String);
-- Add File_Name to Files

--------------
-- Add_File --
--------------

procedure Add_File (File_Name : String) is
begin
Last := @ + 1;
Files (Last) := Create (+File_Name);
end Add_File;

begin
Files := new File_Array
(1 .. Natural (Length (Temporary_File_Storage)) + 4096);
-- Enough to hold all files on the command line and all runtime
-- files.

Temp_Storage_Iterate (Add_File'Access);
Add_Runtime_Files;
Ctx.Analysis_Ctx := Create_Context
(Charset => Charset,
Unit_Provider => Create_Auto_Provider_Reference
(Files (1 .. Last), Charset),
Event_Handler => EHR_Object);
Unchecked_Free (Files);
end;

-- Otherwise use a project unit provider

elsif Gnatcheck_Prj.Tree.Is_Defined and then not In_Aggregate_Project
then
-- Use a project unit provider, even with the implicit project
if not In_Aggregate_Project then
if Partition = null then
Partition :=
Create_Project_Unit_Providers (Gnatcheck_Prj.Tree);
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,10 @@ public String[] getLines() {

@Override
public String fileName() {
return Paths.get(sourceSection.getSource().getPath()).getFileName().toString();
if (sourceSection.getSource().getPath() != null) {
return Paths.get(sourceSection.getSource().getPath()).getFileName().toString();
}
return sourceSection.getSource().getName();
}

@Override
Expand Down
4 changes: 4 additions & 0 deletions testsuite/tests/gnatcheck_errors/missing_source/src/proc2.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
procedure Proc2 is
begin
null;
end Proc2;
13 changes: 13 additions & 0 deletions testsuite/tests/gnatcheck_errors/missing_source/test.out
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
With a non-existing source file
===============================

gnatcheck: not_a_file.adb not found
gnatcheck: No existing file to process
>>>program returned status code 3

With a file not in the project closure
======================================

gnatcheck: src/proc2.adb is not in the analysed project closure (Default)
gnatcheck: No existing file to process
>>>program returned status code 3
12 changes: 12 additions & 0 deletions testsuite/tests/gnatcheck_errors/missing_source/test.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
driver: gnatcheck
description: Test the behavior when providing a invalid source
format: brief
rules:
- +RGoto_Statements
tests:
- label: With a non-existing source file
input_sources:
- not_a_file.adb
- label: With a file not in the project closure
input_sources:
- src/proc2.adb

0 comments on commit 3ba0f76

Please sign in to comment.