gnatmain.adb   [plain text]

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                            G N A T M A I N                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.1.1.2 $
--                                                                          --
--          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
--                                                                          --
-- 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 2,  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 COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with Csets;
with GNAT.Case_Util;
with GNAT.OS_Lib;  use GNAT.OS_Lib;
with Namet;        use Namet;
with Opt;
with Osint;        use Osint;
with Output;       use Output;
with Prj;          use Prj;
with Prj.Env;
with Prj.Ext;      use Prj.Ext;
with Prj.Pars;
with Prj.Util;     use Prj.Util;
with Snames;       use Snames;
with Stringt;      use Stringt;
with Table;
with Types;        use Types;

procedure Gnatmain is

   Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
   Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";

   type Tool_Type is (None, List, Xref, Find, Stub, Make, Comp, Bind, Link);

   --  The tool that is going to be called

   Tool : Tool_Type := None;

   --  For each tool, Tool_Package_Names contains the name of the
   --  corresponding package in the project file.

   Tool_Package_Names : constant array (Tool_Type) of Name_Id :=
     (None    => No_Name,
      List    => Name_Gnatls,
      Xref    => Name_Cross_Reference,
      Find    => Name_Finder,
      Stub    => Name_Gnatstub,
      Comp    => No_Name,
      Make    => No_Name,
      Bind    => No_Name,
      Link    => No_Name);

   --  For each tool, Tool_Names contains the name of the executable
   --  to be spawned.

   Gnatmake : constant String_Access := new String'("gnatmake");

   Tool_Names : constant array (Tool_Type) of String_Access :=
     (None    => null,
      List    => new String'("gnatls"),
      Xref    => new String'("gnatxref"),
      Find    => new String'("gnatfind"),
      Stub    => new String'("gnatstub"),
      Comp    => Gnatmake,
      Make    => Gnatmake,
      Bind    => Gnatmake,
      Link    => Gnatmake);

   Project_File      : String_Access;
   Project           : Prj.Project_Id;
   Current_Verbosity : Prj.Verbosity := Prj.Default;

   --  This flag indicates a switch -p (for gnatxref and gnatfind) for
   --  an old fashioned project file. -p cannot be used in conjonction
   --  with -P.

   Old_Project_File_Used : Boolean := False;

   Next_Arg : Positive;

   --  A table to keep the switches on the command line

   package Saved_Switches is new Table.Table (
     Table_Component_Type => String_Access,
     Table_Index_Type     => Integer,
     Table_Low_Bound      => 1,
     Table_Initial        => 20,
     Table_Increment      => 100,
     Table_Name           => "Gnatmain.Saved_Switches");

   --  A table to keep the switches from the project file

   package Switches is new Table.Table (
     Table_Component_Type => String_Access,
     Table_Index_Type     => Integer,
     Table_Low_Bound      => 1,
     Table_Initial        => 20,
     Table_Increment      => 100,
     Table_Name           => "Gnatmain.Switches");

   procedure Add_Switch (Argv : String; And_Save : Boolean);
   --  Add a switch in one of the tables above

   procedure Display (Program : String; Args : Argument_List);
   --  Displays Program followed by the arguments in Args

   function Index (Char : Character; Str : String) return Natural;
   --  Returns the first occurrence of Char in Str.
   --  Returns 0 if Char is not in Str.

   procedure Scan_Arg (Argv : String; And_Save : Boolean);
   --  Scan and process arguments. Argv is a single argument.

   procedure Usage;
   --  Output usage

   ----------------
   -- Add_Switch --
   ----------------

   procedure Add_Switch (Argv : String; And_Save : Boolean) is
   begin
      if And_Save then
         Saved_Switches.Increment_Last;
         Saved_Switches.Table (Saved_Switches.Last) := new String'(Argv);

      else
         Switches.Increment_Last;
         Switches.Table (Switches.Last) := new String'(Argv);
      end if;
   end Add_Switch;

   -------------
   -- Display --
   -------------

   procedure Display (Program : String; Args : Argument_List) is
   begin
      if not Opt.Quiet_Output then
         Write_Str (Program);

         for J in Args'Range loop
            Write_Str (" ");
            Write_Str (Args (J).all);
         end loop;

         Write_Eol;
      end if;
   end Display;

   -----------
   -- Index --
   -----------

   function Index (Char : Character; Str : String) return Natural is
   begin
      for Index in Str'Range loop
         if Str (Index) = Char then
            return Index;
         end if;
      end loop;

      return 0;
   end Index;

   --------------
   -- Scan_Arg --
   --------------

   procedure Scan_Arg (Argv : String; And_Save : Boolean) is
   begin
      pragma Assert (Argv'First = 1);

      if Argv'Length = 0 then
         return;
      end if;

      if Argv (1) = Switch_Character or else Argv (1) = '-' then

         if Argv'Length = 1 then
            Fail ("switch character cannot be followed by a blank");
         end if;

         --  The two style project files (-p and -P) cannot be used together

         if (Tool = Find or else Tool = Xref)
           and then Argv (2) = 'p'
         then
            Old_Project_File_Used := True;
            if Project_File /= null then
               Fail ("-P and -p cannot be used together");
            end if;
         end if;

         --  -q Be quiet: do not output tool command

         if Argv (2 .. Argv'Last) = "q" then
            Opt.Quiet_Output := True;

            --  Only gnatstub and gnatmake have a -q switch

            if Tool = Stub or else Tool_Names (Tool) = Gnatmake then
               Add_Switch (Argv, And_Save);
            end if;

         --  gnatmake will take care of the project file related switches

         elsif Tool_Names (Tool) = Gnatmake then
            Add_Switch (Argv, And_Save);

         --  -vPx  Specify verbosity while parsing project files

         elsif Argv'Length = 4 and then Argv (2 .. 3) = "vP" then
            case Argv (4) is
               when '0' =>
                  Current_Verbosity := Prj.Default;
               when '1' =>
                  Current_Verbosity := Prj.Medium;
               when '2' =>
                  Current_Verbosity := Prj.High;
               when others =>
                  null;
            end case;

         --  -Pproject_file  Specify project file to be used

         elsif Argv'Length >= 3 and then Argv (2) = 'P' then

            --  Only one -P switch can be used

            if Project_File /= null then
               Fail (Argv & ": second project file forbidden (first is """ &
                     Project_File.all & """)");

            --  The two style project files (-p and -P) cannot be used together

            elsif Old_Project_File_Used then
               Fail ("-p and -P cannot be used together");

            else
               Project_File := new String'(Argv (3 .. Argv'Last));
            end if;

         --  -Xexternal=value Specify an external reference to be used
         --                   in project files

         elsif Argv'Length >= 5 and then Argv (2) = 'X' then
            declare
               Equal_Pos : constant Natural :=
                 Index ('=', Argv (3 .. Argv'Last));
            begin
               if Equal_Pos >= 4 and then
                  Equal_Pos /= Argv'Last then
                  Add (External_Name => Argv (3 .. Equal_Pos - 1),
                       Value => Argv (Equal_Pos + 1 .. Argv'Last));
               else
                  Fail (Argv & " is not a valid external assignment.");
               end if;
            end;

         else
            Add_Switch (Argv, And_Save);
         end if;

      else
         Add_Switch (Argv, And_Save);
      end if;

   end Scan_Arg;

   -----------
   -- Usage --
   -----------

   procedure Usage is
   begin
      Write_Str ("Usage: ");
      Write_Eol;

      Osint.Write_Program_Name;
      Write_Str ("  list  switches [list of object files]");
      Write_Eol;

      Osint.Write_Program_Name;
      Write_Str ("  xref  switches file1 file2 ...");
      Write_Eol;

      Osint.Write_Program_Name;
      Write_Str ("  find  switches pattern[:sourcefile[:line[:column]]] " &
                 "[file1 file2 ...]");
      Write_Eol;

      Osint.Write_Program_Name;
      Write_Str ("  stub  switches filename [directory]");
      Write_Eol;

      Osint.Write_Program_Name;
      Write_Str ("  comp  switches files");
      Write_Eol;

      Osint.Write_Program_Name;
      Write_Str ("  make  switches [files]");
      Write_Eol;

      Osint.Write_Program_Name;
      Write_Str ("  bind  switches files");
      Write_Eol;

      Osint.Write_Program_Name;
      Write_Str ("  link  switches files");
      Write_Eol;

      Write_Eol;

      Write_Str ("switches interpreted by ");
      Osint.Write_Program_Name;
      Write_Str (" for List Xref and Find:");
      Write_Eol;

      Write_Str ("  -q       Be quiet: do not output tool command");
      Write_Eol;

      Write_Str ("  -Pproj   Use GNAT Project File proj");
      Write_Eol;

      Write_Str ("  -vPx     Specify verbosity when parsing " &
                 "GNAT Project Files");
      Write_Eol;

      Write_Str ("  -Xnm=val Specify an external reference for " &
                 "GNAT Project Files");
      Write_Eol;

      Write_Eol;

      Write_Str ("all other arguments are transmited to the tool");
      Write_Eol;

      Write_Eol;

   end Usage;

begin

   Osint.Initialize (Unspecified);

   Namet.Initialize;
   Csets.Initialize;

   Snames.Initialize;

   Prj.Initialize;

   if Arg_Count = 1 then
      Usage;
      return;
   end if;

   --  Get the name of the tool

   declare
      Tool_Name : String (1 .. Len_Arg (1));

   begin
      Fill_Arg (Tool_Name'Address, 1);
      GNAT.Case_Util.To_Lower (Tool_Name);

      if Tool_Name = "list" then
         Tool := List;

      elsif Tool_Name = "xref" then
         Tool := Xref;

      elsif Tool_Name = "find" then
         Tool := Find;

      elsif Tool_Name = "stub" then
         Tool := Stub;

      elsif Tool_Name = "comp" then
         Tool := Comp;

      elsif Tool_Name = "make" then
         Tool := Make;

      elsif Tool_Name = "bind" then
         Tool := Bind;

      elsif Tool_Name = "link" then
         Tool := Link;

      else
         Fail ("first argument needs to be ""list"", ""xref"", ""find""" &
               ", ""stub"", ""comp"", ""make"", ""bind"" or ""link""");
      end if;
   end;

   Next_Arg := 2;

   --  Get the command line switches that follow the name of the tool

   Scan_Args : while Next_Arg < Arg_Count loop
      declare
         Next_Argv : String (1 .. Len_Arg (Next_Arg));

      begin
         Fill_Arg (Next_Argv'Address, Next_Arg);
         Scan_Arg (Next_Argv, And_Save => True);
      end;

      Next_Arg := Next_Arg + 1;
   end loop Scan_Args;

   --  If a switch -P was specified, parse the project file.
   --  Project_File is always null if we are going to invoke gnatmake,
   --  that is when Tool is Comp, Make, Bind or Link.

   if Project_File /= null then

      Prj.Pars.Set_Verbosity (To => Current_Verbosity);

      Prj.Pars.Parse
        (Project           => Project,
         Project_File_Name => Project_File.all);

      if Project = Prj.No_Project then
         Fail ("""" & Project_File.all & """ processing failed");
      end if;

      --  Check if a package with the name of the tool is in the project file
      --  and if there is one, get the switches, if any, and scan them.

      declare
         Data       : Prj.Project_Data := Prj.Projects.Table (Project);
         Pkg        : Prj.Package_Id :=
                        Prj.Util.Value_Of
                          (Name        => Tool_Package_Names (Tool),
                           In_Packages => Data.Decl.Packages);
         Element    : Package_Element;
         Default_Switches_Array : Array_Element_Id;
         Switches   : Prj.Variable_Value;
         Current    : Prj.String_List_Id;
         The_String : String_Element;

      begin
         if Pkg /= No_Package then
            Element := Packages.Table (Pkg);

            --  Packages Gnatls and Gnatstub have a single attribute Switches,
            --  that is not an associative array.

            if Tool = List or else Tool = Stub then
               Switches :=
                 Prj.Util.Value_Of
                   (Variable_Name => Name_Switches,
                    In_Variables => Element.Decl.Attributes);

               --  Packages Cross_Reference (for gnatxref) and Finder
               --  (for gnatfind) have an attributed Default_Switches,
               --  an associative array, indexed by the name of the
               --  programming language.
            else
               Default_Switches_Array :=
                 Prj.Util.Value_Of
                   (Name => Name_Default_Switches,
                    In_Arrays => Packages.Table (Pkg).Decl.Arrays);
               Switches := Prj.Util.Value_Of
                 (Index => Name_Ada,
                  In_Array => Default_Switches_Array);

            end if;

            --  If there are switches specified in the package of the
            --  project file corresponding to the tool, scan them.

            case Switches.Kind is
               when Prj.Undefined =>
                  null;

               when Prj.Single =>
                  if String_Length (Switches.Value) > 0 then
                     String_To_Name_Buffer (Switches.Value);
                     Scan_Arg
                       (Name_Buffer (1 .. Name_Len),
                        And_Save => False);
                  end if;

               when Prj.List =>
                  Current := Switches.Values;
                  while Current /= Prj.Nil_String loop
                     The_String := String_Elements.Table (Current);

                     if String_Length (The_String.Value) > 0 then
                        String_To_Name_Buffer (The_String.Value);
                        Scan_Arg
                          (Name_Buffer (1 .. Name_Len),
                           And_Save => False);
                     end if;

                     Current := The_String.Next;
                  end loop;
            end case;
         end if;
      end;

      --  Set up the environment variables ADA_INCLUDE_PATH and
      --  ADA_OBJECTS_PATH.

      Setenv
        (Name  => Ada_Include_Path,
         Value => Prj.Env.Ada_Include_Path (Project).all);
      Setenv
        (Name  => Ada_Objects_Path,
         Value => Prj.Env.Ada_Objects_Path
                       (Project, Including_Libraries => False).all);

   end if;

   --  Gather all the arguments, those from the project file first,
   --  locate the tool and call it with the arguments.

   declare
      Args    : Argument_List (1 .. Switches.Last + Saved_Switches.Last + 4);
      Arg_Num : Natural := 0;
      Tool_Path : String_Access;
      Success : Boolean;

      procedure Add (Arg : String_Access);

      procedure Add (Arg : String_Access) is
      begin
         Arg_Num := Arg_Num + 1;
         Args (Arg_Num) := Arg;
      end Add;

   begin

      case Tool is
         when Comp =>
            Add (new String'("-u"));
            Add (new String'("-f"));

         when Bind =>
            Add (new String'("-b"));

         when Link =>
            Add (new String'("-l"));

         when others =>
            null;

      end case;

      for Index in 1 .. Switches.Last loop
         Arg_Num := Arg_Num + 1;
         Args (Arg_Num) := Switches.Table (Index);
      end loop;

      for Index in 1 .. Saved_Switches.Last loop
         Arg_Num := Arg_Num + 1;
         Args (Arg_Num) := Saved_Switches.Table (Index);
      end loop;

      Tool_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Tool_Names (Tool).all);

      if Tool_Path = null then
         Fail ("error, unable to locate " & Tool_Names (Tool).all);
      end if;

      Display (Tool_Names (Tool).all, Args (1 .. Arg_Num));

      GNAT.OS_Lib.Spawn (Tool_Path.all, Args (1 .. Arg_Num), Success);

   end;

end Gnatmain;