Skip to content

Commit

Permalink
Libadalang.Helpers.App: new formal to control GPR "missing dirs" warns
Browse files Browse the repository at this point in the history
In addition to adding this new formal, also use it to disable warnings
in lal_dda.adb, nameres.adb and navigate.adb.
  • Loading branch information
pmderodat committed Jul 18, 2024
1 parent a626ecc commit 8f5be0f
Show file tree
Hide file tree
Showing 25 changed files with 200 additions and 25 deletions.
27 changes: 18 additions & 9 deletions extensions/src/libadalang-helpers.adb
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,8 @@ package body Libadalang.Helpers is
(Project_File : String;
Scenario_Vars : Unbounded_String_Array := Empty_Array;
Target, RTS, Config_File : String := "";
Project : in out GPR2.Project.Tree.Object);
Project : in out GPR2.Project.Tree.Object;
Absent_Dir_Error : GPR2.Error_Level := GPR2.Warning);
-- Same as the corresponding overloaded procedure in the package spec, but
-- for GPR2.

Expand Down Expand Up @@ -434,7 +435,10 @@ package body Libadalang.Helpers is
Target,
RTS,
Config_File,
GPR2_Project);
GPR2_Project,
(if GPR_Absent_Dir_Warning
then GPR2.Warning
else GPR2.No_Error));
UFP := Project_To_Provider (GPR2_Project);
else
Load_Project
Expand All @@ -444,7 +448,8 @@ package body Libadalang.Helpers is
RTS,
Config_File,
Project,
Env);
Env,
GPR_Absent_Dir_Warning);
UFP := Project_To_Provider (Project);
end if;

Expand Down Expand Up @@ -740,7 +745,8 @@ package body Libadalang.Helpers is
Scenario_Vars : Unbounded_String_Array := Empty_Array;
Target, RTS, Config_File : String := "";
Project : out Project_Tree_Access;
Env : out Project_Environment_Access)
Env : out Project_Environment_Access;
Report_Missing_Dirs : Boolean := True)
is
procedure Cleanup;
-- Cleanup helpers for error handling
Expand Down Expand Up @@ -797,9 +803,10 @@ package body Libadalang.Helpers is
-- the project in a unit provider.
begin
Project.Load
(Root_Project_Path => Create (+Project_File),
Env => Env,
Errors => Print_Error'Access);
(Root_Project_Path => Create (+Project_File),
Env => Env,
Errors => Print_Error'Access,
Report_Missing_Dirs => Report_Missing_Dirs);
exception
when Invalid_Project =>
Libadalang.Project_Provider.Trace.Trace ("Loading failed");
Expand All @@ -817,7 +824,8 @@ package body Libadalang.Helpers is
(Project_File : String;
Scenario_Vars : Unbounded_String_Array := Empty_Array;
Target, RTS, Config_File : String := "";
Project : in out GPR2.Project.Tree.Object)
Project : in out GPR2.Project.Tree.Object;
Absent_Dir_Error : GPR2.Error_Level := GPR2.Warning)
is
Options : GPR2.Options.Object;
Error : Boolean := False;
Expand Down Expand Up @@ -862,7 +870,8 @@ package body Libadalang.Helpers is
Options.Add_Switch (GPR2.Options.RTS, RTS);
end if;

Error := not Project.Load (Options);
Error := not Project.Load
(Options, Absent_Dir_Error => Absent_Dir_Error);
exception
when Exc : GPR2.Project_Error =>
Error := True;
Expand Down
9 changes: 8 additions & 1 deletion extensions/src/libadalang-helpers.ads
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,8 @@ package Libadalang.Helpers is
Scenario_Vars : Unbounded_String_Array := Empty_Array;
Target, RTS, Config_File : String := "";
Project : out Project_Tree_Access;
Env : out Project_Environment_Access);
Env : out Project_Environment_Access;
Report_Missing_Dirs : Boolean := True);
-- Load ``Project_File`` using scenario variables given in
-- ``Scenario_Vars``, and given ``Target``, ``RTS` and ``Config_File``.
-- Populate ``Project`` and ``Env`` accordingly.
Expand All @@ -45,6 +46,8 @@ package Libadalang.Helpers is
-- See ``GNATCOLL.Projects.Set_Target_And_Runtime`` as well as
-- ``GNATCOLL.Projects.Set_Config_File`` for more details about the use of
-- ``Target``, ``RTS`` and ``Config_File``.
--
-- ``Report_Missing_Dirs`` is passed to ``GNATCOLL.Projects.Load``.

function Project_To_Provider
(Project : Project_Tree_Access) return Unit_Provider_Reference;
Expand Down Expand Up @@ -182,6 +185,10 @@ package Libadalang.Helpers is
-- Finally, once all jobs are done, the main task calls
-- App_Post_Process.

GPR_Absent_Dir_Warning : Boolean := True;
-- Whether missing directories in loaded GPR projects should be reported
-- as warnings, or ignored.

with procedure App_Setup
(Context : App_Context; Jobs : App_Job_Context_Array) is null;
-- This procedure is called right after command line options are parsed,
Expand Down
9 changes: 5 additions & 4 deletions testsuite/ada/lal_dda.adb
Original file line number Diff line number Diff line change
Expand Up @@ -65,11 +65,12 @@ procedure LAL_DDA is
procedure App_Setup (Context : App_Context; Jobs : App_Job_Context_Array);
procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit);
package App is new Libadalang.Helpers.App
(Name => "lal_dda",
Description =>
(Name => "lal_dda",
Description =>
"Exercize Libadalang's Data_Decomposition API on type declarations",
App_Setup => App_Setup,
Process_Unit => Process_Unit);
GPR_Absent_Dir_Warning => False,
App_Setup => App_Setup,
Process_Unit => Process_Unit);

package Args is
use GNATCOLL.Opt_Parse;
Expand Down
17 changes: 9 additions & 8 deletions testsuite/ada/nameres.adb
Original file line number Diff line number Diff line change
Expand Up @@ -106,15 +106,16 @@ procedure Nameres is
procedure Print_Stats (Jobs : App_Job_Context_Array);

package App is new Libadalang.Helpers.App
(Name => "nameres",
Description =>
(Name => "nameres",
Description =>
"Run Libadalang's name resolution on a file, set of files or project",
Enable_Parallelism => True,
App_Setup => App_Setup,
Job_Setup => Job_Setup,
Process_Unit => Process_Unit,
Job_Post_Process => Job_Post_Process,
App_Post_Process => App_Post_Process);
Enable_Parallelism => True,
GPR_Absent_Dir_Warning => False,
App_Setup => App_Setup,
Job_Setup => Job_Setup,
Process_Unit => Process_Unit,
Job_Post_Process => Job_Post_Process,
App_Post_Process => App_Post_Process);

package Args is
use GNATCOLL.Opt_Parse;
Expand Down
7 changes: 4 additions & 3 deletions testsuite/ada/navigate.adb
Original file line number Diff line number Diff line change
Expand Up @@ -30,9 +30,10 @@ procedure Navigate is
(Context : Libadalang.Helpers.App_Job_Context; Unit : LAL.Analysis_Unit);

package App is new Libadalang.Helpers.App
(Name => "navigate",
Description => "Navigate between AST nodes (spec/body/...).",
Process_Unit => Process_File);
(Name => "navigate",
Description => "Navigate between AST nodes (spec/body/...).",
GPR_Absent_Dir_Warning => False,
Process_Unit => Process_File);

package Args is
use GNATCOLL.Opt_Parse;
Expand Down
29 changes: 29 additions & 0 deletions testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/main.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,29 @@
-- Check that App does not report GPR missing directories when asked not to

with Ada.Text_IO; use Ada.Text_IO;

with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Helpers; use Libadalang.Helpers;

procedure Main is
procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit);

package App is new Libadalang.Helpers.App
(Name => "example",
Description => "Example app",
Process_Unit => Process_Unit,
GPR_Absent_Dir_Warning => False);

------------------
-- Process_Unit --
------------------

procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit) is
pragma Unreferenced (Context);
begin
Put_Line (Unit.Root.Image);
end Process_Unit;

begin
App.Run;
end Main;
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
package P is
end P;
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
project P is
for Source_Files use ("p.ads");
for Object_Dir use "obj-p";
end P;
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
<CompilationUnit p.ads:1:1-2:7>
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
driver: ada-api
main: main.adb
argv: [-Pp.gpr]
28 changes: 28 additions & 0 deletions testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/main.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
-- Check that App reports GPR missing directories by default

with Ada.Text_IO; use Ada.Text_IO;

with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Helpers; use Libadalang.Helpers;

procedure Main is
procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit);

package App is new Libadalang.Helpers.App
(Name => "example",
Description => "Example app",
Process_Unit => Process_Unit);

------------------
-- Process_Unit --
------------------

procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit) is
pragma Unreferenced (Context);
begin
Put_Line (Unit.Root.Image);
end Process_Unit;

begin
App.Run;
end Main;
2 changes: 2 additions & 0 deletions testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.ads
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
package P is
end P;
4 changes: 4 additions & 0 deletions testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.gpr
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
project P is
for Source_Files use ("p.ads");
for Object_Dir use "obj-p";
end P;
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
p.gpr:3:23: warning: object directory "obj-p" not found
<CompilationUnit p.ads:1:1-2:7>
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
driver: ada-api
main: main.adb
argv: [-Pp.gpr]
29 changes: 29 additions & 0 deletions testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/main.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,29 @@
-- Check that App does not report GPR missing directories when asked not to

with Ada.Text_IO; use Ada.Text_IO;

with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Helpers; use Libadalang.Helpers;

procedure Main is
procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit);

package App is new Libadalang.Helpers.App
(Name => "example",
Description => "Example app",
Process_Unit => Process_Unit,
GPR_Absent_Dir_Warning => False);

------------------
-- Process_Unit --
------------------

procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit) is
pragma Unreferenced (Context);
begin
Put_Line (Unit.Root.Image);
end Process_Unit;

begin
App.Run;
end Main;
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
package P is
end P;
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
project P is
for Source_Files use ("p.ads");
for Object_Dir use "obj-p";
end P;
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
<CompilationUnit p.ads:1:1-2:7>
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
driver: ada-api
main: main.adb
argv: [-Pp.gpr, --gpr2]
28 changes: 28 additions & 0 deletions testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/main.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
-- Check that App reports GPR missing directories by default with --gpr2

with Ada.Text_IO; use Ada.Text_IO;

with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Helpers; use Libadalang.Helpers;

procedure Main is
procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit);

package App is new Libadalang.Helpers.App
(Name => "example",
Description => "Example app",
Process_Unit => Process_Unit);

------------------
-- Process_Unit --
------------------

procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit) is
pragma Unreferenced (Context);
begin
Put_Line (Unit.Root.Image);
end Process_Unit;

begin
App.Run;
end Main;
2 changes: 2 additions & 0 deletions testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.ads
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
package P is
end P;
4 changes: 4 additions & 0 deletions testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.gpr
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
project P is
for Source_Files use ("p.ads");
for Object_Dir use "obj-p";
end P;
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
p.gpr:3:23: warning: object directory "obj-p" not found
<CompilationUnit p.ads:1:1-2:7>
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
driver: ada-api
main: main.adb
argv: [-Pp.gpr, --gpr2]

0 comments on commit 8f5be0f

Please sign in to comment.