From 8f5be0fce1bc34ead7b7ef0edce0f92752db8941 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Thu, 18 Jul 2024 09:52:00 +0000 Subject: [PATCH] Libadalang.Helpers.App: new formal to control GPR "missing dirs" warns In addition to adding this new formal, also use it to disable warnings in lal_dda.adb, nameres.adb and navigate.adb. --- extensions/src/libadalang-helpers.adb | 27 +++++++++++------ extensions/src/libadalang-helpers.ads | 9 +++++- testsuite/ada/lal_dda.adb | 9 +++--- testsuite/ada/nameres.adb | 17 ++++++----- testsuite/ada/navigate.adb | 7 +++-- .../gpr_missing_dirs/gpr1-no-warn/main.adb | 29 +++++++++++++++++++ .../app/gpr_missing_dirs/gpr1-no-warn/p.ads | 2 ++ .../app/gpr_missing_dirs/gpr1-no-warn/p.gpr | 4 +++ .../gpr_missing_dirs/gpr1-no-warn/test.out | 1 + .../gpr_missing_dirs/gpr1-no-warn/test.yaml | 3 ++ .../app/gpr_missing_dirs/gpr1-warn/main.adb | 28 ++++++++++++++++++ .../app/gpr_missing_dirs/gpr1-warn/p.ads | 2 ++ .../app/gpr_missing_dirs/gpr1-warn/p.gpr | 4 +++ .../app/gpr_missing_dirs/gpr1-warn/test.out | 2 ++ .../app/gpr_missing_dirs/gpr1-warn/test.yaml | 3 ++ .../gpr_missing_dirs/gpr2-no-warn/main.adb | 29 +++++++++++++++++++ .../app/gpr_missing_dirs/gpr2-no-warn/p.ads | 2 ++ .../app/gpr_missing_dirs/gpr2-no-warn/p.gpr | 4 +++ .../gpr_missing_dirs/gpr2-no-warn/test.out | 1 + .../gpr_missing_dirs/gpr2-no-warn/test.yaml | 3 ++ .../app/gpr_missing_dirs/gpr2-warn/main.adb | 28 ++++++++++++++++++ .../app/gpr_missing_dirs/gpr2-warn/p.ads | 2 ++ .../app/gpr_missing_dirs/gpr2-warn/p.gpr | 4 +++ .../app/gpr_missing_dirs/gpr2-warn/test.out | 2 ++ .../app/gpr_missing_dirs/gpr2-warn/test.yaml | 3 ++ 25 files changed, 200 insertions(+), 25 deletions(-) create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/main.adb create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.ads create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.gpr create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.out create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.yaml create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/main.adb create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.ads create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.gpr create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/test.out create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/test.yaml create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/main.adb create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.ads create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.gpr create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.out create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.yaml create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/main.adb create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.ads create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.gpr create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/test.out create mode 100644 testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/test.yaml diff --git a/extensions/src/libadalang-helpers.adb b/extensions/src/libadalang-helpers.adb index bc2e00afc..55a98905a 100644 --- a/extensions/src/libadalang-helpers.adb +++ b/extensions/src/libadalang-helpers.adb @@ -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. @@ -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 @@ -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; @@ -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 @@ -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"); @@ -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; @@ -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; diff --git a/extensions/src/libadalang-helpers.ads b/extensions/src/libadalang-helpers.ads index 0d8ba6bf3..b81ac939c 100644 --- a/extensions/src/libadalang-helpers.ads +++ b/extensions/src/libadalang-helpers.ads @@ -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. @@ -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; @@ -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, diff --git a/testsuite/ada/lal_dda.adb b/testsuite/ada/lal_dda.adb index fce91b48b..638fb42e9 100644 --- a/testsuite/ada/lal_dda.adb +++ b/testsuite/ada/lal_dda.adb @@ -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; diff --git a/testsuite/ada/nameres.adb b/testsuite/ada/nameres.adb index a771cbbca..58a060d65 100644 --- a/testsuite/ada/nameres.adb +++ b/testsuite/ada/nameres.adb @@ -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; diff --git a/testsuite/ada/navigate.adb b/testsuite/ada/navigate.adb index 7f1a848b8..01aa485cc 100644 --- a/testsuite/ada/navigate.adb +++ b/testsuite/ada/navigate.adb @@ -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; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/main.adb b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/main.adb new file mode 100644 index 000000000..82c9b27c2 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/main.adb @@ -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; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.ads b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.ads new file mode 100644 index 000000000..36182b4a1 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.ads @@ -0,0 +1,2 @@ +package P is +end P; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.gpr b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.gpr new file mode 100644 index 000000000..3b1fa2678 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.gpr @@ -0,0 +1,4 @@ +project P is + for Source_Files use ("p.ads"); + for Object_Dir use "obj-p"; +end P; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.out b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.out new file mode 100644 index 000000000..cb10e1a79 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.out @@ -0,0 +1 @@ + diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.yaml b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.yaml new file mode 100644 index 000000000..a0c517dcd --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.yaml @@ -0,0 +1,3 @@ +driver: ada-api +main: main.adb +argv: [-Pp.gpr] diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/main.adb b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/main.adb new file mode 100644 index 000000000..737ca0ed1 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/main.adb @@ -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; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.ads b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.ads new file mode 100644 index 000000000..36182b4a1 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.ads @@ -0,0 +1,2 @@ +package P is +end P; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.gpr b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.gpr new file mode 100644 index 000000000..3b1fa2678 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.gpr @@ -0,0 +1,4 @@ +project P is + for Source_Files use ("p.ads"); + for Object_Dir use "obj-p"; +end P; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/test.out b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/test.out new file mode 100644 index 000000000..464be30eb --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/test.out @@ -0,0 +1,2 @@ +p.gpr:3:23: warning: object directory "obj-p" not found + diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/test.yaml b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/test.yaml new file mode 100644 index 000000000..a0c517dcd --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/test.yaml @@ -0,0 +1,3 @@ +driver: ada-api +main: main.adb +argv: [-Pp.gpr] diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/main.adb b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/main.adb new file mode 100644 index 000000000..82c9b27c2 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/main.adb @@ -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; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.ads b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.ads new file mode 100644 index 000000000..36182b4a1 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.ads @@ -0,0 +1,2 @@ +package P is +end P; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.gpr b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.gpr new file mode 100644 index 000000000..3b1fa2678 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.gpr @@ -0,0 +1,4 @@ +project P is + for Source_Files use ("p.ads"); + for Object_Dir use "obj-p"; +end P; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.out b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.out new file mode 100644 index 000000000..cb10e1a79 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.out @@ -0,0 +1 @@ + diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.yaml b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.yaml new file mode 100644 index 000000000..1001aa47e --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.yaml @@ -0,0 +1,3 @@ +driver: ada-api +main: main.adb +argv: [-Pp.gpr, --gpr2] diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/main.adb b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/main.adb new file mode 100644 index 000000000..85085a251 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/main.adb @@ -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; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.ads b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.ads new file mode 100644 index 000000000..36182b4a1 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.ads @@ -0,0 +1,2 @@ +package P is +end P; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.gpr b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.gpr new file mode 100644 index 000000000..3b1fa2678 --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.gpr @@ -0,0 +1,4 @@ +project P is + for Source_Files use ("p.ads"); + for Object_Dir use "obj-p"; +end P; diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/test.out b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/test.out new file mode 100644 index 000000000..464be30eb --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/test.out @@ -0,0 +1,2 @@ +p.gpr:3:23: warning: object directory "obj-p" not found + diff --git a/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/test.yaml b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/test.yaml new file mode 100644 index 000000000..1001aa47e --- /dev/null +++ b/testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/test.yaml @@ -0,0 +1,3 @@ +driver: ada-api +main: main.adb +argv: [-Pp.gpr, --gpr2]