Merge branch 'mr/pmderodat/gpr-warnings' into 'master'

Libadalang.Helpers.App: new formal to control GPR "missing dirs" warns

Closes #1419

See merge request eng/libadalang/libadalang!1704

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;

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,

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;

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;

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;

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;

testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/p.ads

@@ -0,0 +1,2 @@
+package P is
+end P;

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;

testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-no-warn/test.out

@@ -0,0 +1 @@
+<CompilationUnit p.ads:1:1-2:7>

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]

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;

testsuite/tests/ada_api/app/gpr_missing_dirs/gpr1-warn/p.ads

@@ -0,0 +1,2 @@
+package P is
+end P;

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;

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
+<CompilationUnit p.ads:1:1-2:7>

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]

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;

testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/p.ads

@@ -0,0 +1,2 @@
+package P is
+end P;

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;

testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-no-warn/test.out

@@ -0,0 +1 @@
+<CompilationUnit p.ads:1:1-2:7>

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]

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;

testsuite/tests/ada_api/app/gpr_missing_dirs/gpr2-warn/p.ads

@@ -0,0 +1,2 @@
+package P is
+end P;

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;

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
+<CompilationUnit p.ads:1:1-2:7>

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]