gcc/ada/vxlink.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                               V X L I N K                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2018, AdaCore                          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;

with Ada.Command_Line;
with Ada.Strings.Unbounded;     use Ada.Strings.Unbounded;
with 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;

package body VxLink is

   Target_Triplet : Unbounded_String := Null_Unbounded_String;
   Verbose        : Boolean := False;
   Error_State    : Boolean := False;

   function Triplet return String;
   --  ??? missing spec

   function Which (Exe : String) return String;
   --  ??? missing spec

   -------------
   -- Triplet --
   -------------

   function Triplet return String is
   begin
      if Target_Triplet = Null_Unbounded_String then
         declare
            Exe : constant String := File_Name (Ada.Command_Line.Command_Name);
         begin
            for J in reverse Exe'Range loop
               if Exe (J) = '-' then
                  Target_Triplet := To_Unbounded_String (Exe (Exe'First .. J));
                  exit;
               end if;
            end loop;
         end;
      end if;

      return To_String (Target_Triplet);
   end Triplet;

   -----------
   -- Which --
   -----------

   function Which (Exe : String) return String is
      Suffix   : GNAT.OS_Lib.String_Access := Get_Executable_Suffix;
      Basename : constant String := Exe & Suffix.all;
      Path     : GNAT.OS_Lib.String_Access := Getenv ("PATH");
      Last     : Natural := Path'First;

   begin
      Free (Suffix);

      for J in Path'Range loop
         if Path (J) = Path_Separator then
            declare
               Full : constant String := Normalize_Pathname
                 (Name           => Basename,
                  Directory      => Path (Last .. J - 1),
                  Resolve_Links  => False,
                  Case_Sensitive => True);
            begin
               if Is_Executable_File (Full) then
                  Free (Path);

                  return Full;
               end if;
            end;

            Last := J + 1;
         end if;
      end loop;

      Free (Path);

      return "";
   end Which;

   -----------------
   -- Set_Verbose --
   -----------------

   procedure Set_Verbose (Value : Boolean) is
   begin
      Verbose := Value;
   end Set_Verbose;

   ----------------
   -- Is_Verbose --
   ----------------

   function Is_Verbose return Boolean is
   begin
      return Verbose;
   end Is_Verbose;

   ---------------------
   -- Set_Error_State --
   ---------------------

   procedure Set_Error_State (Message : String) is
   begin
      Log_Error ("Error: " & Message);
      Error_State := True;
      Ada.Command_Line.Set_Exit_Status (1);
   end Set_Error_State;

   --------------------
   -- Is_Error_State --
   --------------------

   function Is_Error_State return Boolean is
   begin
      return Error_State;
   end Is_Error_State;

   --------------
   -- Log_Info --
   --------------

   procedure Log_Info (S : String) is
   begin
      if Verbose then
         Ada.Text_IO.Put_Line (S);
      end if;
   end Log_Info;

   ---------------
   -- Log_Error --
   ---------------

   procedure Log_Error (S : String) is
   begin
      Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, S);
   end Log_Error;

   ---------
   -- Run --
   ---------

   procedure Run (Arguments : Arguments_List) is
      Output : constant String := Run (Arguments);
   begin
      if not Is_Error_State then
         --  In case of erroneous execution, the function version of run will
         --  have already displayed the output
         Ada.Text_IO.Put (Output);
      end if;
   end Run;

   ---------
   -- Run --
   ---------

   function Run (Arguments : Arguments_List) return String is
      Args       : GNAT.OS_Lib.Argument_List_Access :=
                     new GNAT.OS_Lib.Argument_List
                       (1 .. Natural (Arguments.Length) - 1);
      Base       : constant String := Base_Name (Arguments.First_Element);

      Debug_Line : Unbounded_String;
      Add_Quotes : Boolean;

   begin
      if Verbose then
         Append (Debug_Line, Base);
      end if;

      for J in Arguments.First_Index + 1 .. Arguments.Last_Index loop
         declare
            Arg : String renames Arguments.Element (J);
         begin
            Args (J - 1) := new String'(Arg);

            if Verbose then
               Add_Quotes := False;

               for K in Arg'Range loop
                  if Arg (K) = ' ' then
                     Add_Quotes := True;
                     exit;
                  end if;
               end loop;

               Append (Debug_Line, ' ');

               if Add_Quotes then
                  Append (Debug_Line, '"' & Arg & '"');
               else
                  Append (Debug_Line, Arg);
               end if;
            end if;
         end;
      end loop;

      if Verbose then
         Ada.Text_IO.Put_Line (To_String (Debug_Line));
      end if;

      declare
         Status : aliased Integer := 0;
         Ret    : constant String :=
                    Get_Command_Output
                      (Command    => Arguments.First_Element,
                       Arguments  => Args.all,
                       Input      => "",
                       Status     => Status'Access,
                       Err_To_Out => True);

      begin
         GNAT.OS_Lib.Free (Args);

         if Status /= 0 then
            Ada.Text_IO.Put_Line (Ret);
            Set_Error_State
              (Base_Name (Arguments.First_Element) &
                 " returned" & Status'Image);
         end if;

         return Ret;
      end;
   end Run;

   ---------
   -- Gcc --
   ---------

   function Gcc return String is
   begin
      return Which (Triplet & "gcc");
   end Gcc;

   ---------
   -- Gxx --
   ---------

   function Gxx return String is
   begin
      return Which (Triplet & "g++");
   end Gxx;

   --------
   -- Nm --
   --------

   function Nm return String is
   begin
      return Which (Triplet & "nm");
   end Nm;

end VxLink;