Merge branch 'default_target_codepeer' into 'master'

Set default target to codepeer

See merge request eng/libadalang/langkit-query-language!41

lkql_checker/src/gnatcheck-compiler.adb

@@ -1351,6 +1351,50 @@ package body Gnatcheck.Compiler is
       end if;
    end Restriction_Rule_Parameter;
 
+   ----------------------------
+   -- Has_Access_To_Codepeer --
+   ----------------------------
+
+   function Has_Access_To_Codepeer return Boolean
+   is
+      Gnatls : String_Access := Locate_Exec_On_Path ("codepeer-gnatls");
+      Res   : Boolean := False;
+   begin
+      if Gnatls /= null then
+         Res := True;
+         Free (Gnatls);
+      end if;
+      return Res;
+   end Has_Access_To_Codepeer;
+
+   -------------------
+   -- GPRbuild_Exec --
+   -------------------
+
+   function GPRbuild_Exec return String is
+   begin
+      if Has_Access_To_Codepeer then
+         return "codepeer-gprbuild";
+      else
+         return "gprbuild";
+      end if;
+   end GPRbuild_Exec;
+
+   ----------------
+   -- Gnatls_Exec --
+   ----------------
+
+   function Gnatls_Exec return String is
+   begin
+      if Has_Access_To_Codepeer then
+         return "codepeer-gnatls";
+      elsif Target.all /= "" then
+         return Target.all & "-gnatls";
+      else
+         return "gnatls";
+      end if;
+   end Gnatls_Exec;
+
    -------------------------
    -- Set_Compiler_Checks --
    -------------------------
@@ -1448,6 +1492,9 @@ package body Gnatcheck.Compiler is
          if Target.all /= "" then
             Num_Args := @ + 1;
             Args (Num_Args) := new String'("--target=" & Target.all);
+         elsif Has_Access_To_Codepeer then
+            Num_Args := @ + 1;
+            Args (Num_Args) := new String'("--target=codepeer");
          end if;
       else
          --  Target and runtime will be taken from config project anyway
@@ -1514,7 +1561,7 @@ package body Gnatcheck.Compiler is
 
    function Spawn_GPRbuild (Output_File : String) return Process_Id is
       Pid         : Process_Id;
-      GPRbuild    : String_Access := Locate_Exec_On_Path ("gprbuild");
+      GPRbuild    : String_Access := Locate_Exec_On_Path (GPRbuild_Exec);
       Prj         : constant String := Gnatcheck_Prj.Source_Prj;
       Last_Source : constant SF_Id := Last_Argument_Source;
       Args        : Argument_List (1 .. 128 + Integer (Last_Source));
@@ -1537,6 +1584,11 @@ package body Gnatcheck.Compiler is
       Args (8) := new String'("--restricted-to-languages=ada");
       Num_Args := 8;
 
+      if Has_Access_To_Codepeer then
+         Num_Args := @ + 1;
+         Args (Num_Args) := new String'("--target=codepeer");
+      end if;
+
       if Process_Num > 1 then
          Num_Args := @ + 1;
          Args (Num_Args) := new String'("-j" & Image (Process_Num));
@@ -1581,7 +1633,7 @@ package body Gnatcheck.Compiler is
       Append_Variables (Args, Num_Args);
 
       if Debug_Mode then
-         Put ("gprbuild");
+         Put (GPRbuild_Exec);
 
          for J in 1 .. Num_Args loop
             Put (" " & Args (J).all);

lkql_checker/src/gnatcheck-compiler.ads

@@ -25,6 +25,21 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
 
 package Gnatcheck.Compiler is
 
+   ---------------------
+   -- Runtime helpers --
+   ---------------------
+
+   function Has_Access_To_Codepeer return Boolean;
+   --  Returns whether the current gnatcheck process can access to the codepeer
+   --  tools. This function tests if the `codepeer-gnatls` executable can be
+   --  accessed.
+
+   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 --
    --------------------------------------------------------

lkql_checker/src/gnatcheck-projects.adb

@@ -967,6 +967,17 @@ package body Gnatcheck.Projects is
       GPR2.Project.Registry.Pack.Check_Attributes (+"Check");
    end Register_Tool_Attributes;
 
+   ------------------------
+   -- Set_Default_Target --
+   ------------------------
+
+   procedure Set_Default_Target is
+   begin
+      if not Gnatkp_Mode and then Has_Access_To_Codepeer then
+         GPR2.KB.Set_Default_Target ("codepeer");
+      end if;
+   end Set_Default_Target;
+
    -------------------------
    -- Set_External_Values --
    -------------------------
@@ -1769,11 +1780,7 @@ package body Gnatcheck.Projects is
                      --  Target hasn't been set explicitly and codepeer-gnatls
                      --  is available, force its use by setting the "codepeer"
                      --  target.
-
-                     if Target'Length = 0
-                       and then Locate_Exec_On_Path ("codepeer-gnatls") /= null
-                     then
-                        Free (Target);
+                     if Target'Length = 0 and then Has_Access_To_Codepeer then
                         Target := new String'("codepeer");
                      end if;
 

lkql_checker/src/gnatcheck-projects.ads

@@ -354,6 +354,10 @@ package Gnatcheck.Projects is
    -- General project file processing --
    -------------------------------------
 
+   procedure Set_Default_Target;
+   --  If codepeer is on PATH, replaces default target with "codepeer",
+   --  does nothing in gnatkp mode.
+
    procedure Initialize_Environment;
    --  Initializes the environment for extracting the information from the
    --  project file. This includes setting the parameters specific for the

lkql_checker/src/gnatcheck-source_table.adb

@@ -40,6 +40,7 @@ with GPR2.Project.Tree;
 with GPR2.Project.View;
 with GPR2.Project.Source.Set;
 
+with Gnatcheck.Compiler;          use Gnatcheck.Compiler;
 with Gnatcheck.Diagnoses;         use Gnatcheck.Diagnoses;
 with Gnatcheck.Ids;               use Gnatcheck.Ids;
 with Gnatcheck.Output;            use Gnatcheck.Output;
@@ -1500,10 +1501,7 @@ package body Gnatcheck.Source_Table is
       -----------------------
 
       procedure Add_Runtime_Files is
-         Gnatls  : String_Access :=
-           Locate_Exec_On_Path (if Target.all /= ""
-                                then Target.all & "-gnatls"
-                                else "gnatls");
+         Gnatls  : String_Access := Locate_Exec_On_Path (Gnatls_Exec);
          Verbose : aliased String := "-v";
          Status  : aliased Integer;
 

lkql_checker/src/gnatcheck_main.adb

@@ -377,6 +377,8 @@ begin
       OS_Exit (E_Success);
    end if;
 
+   Gnatcheck.Projects.Set_Default_Target;
+
    --  If we have the project file specified as a tool parameter, analyze it.
 
    Gnatcheck.Projects.Process_Project_File (Gnatcheck_Prj);