* gnatmain.adb: Initial version.

	* gnatmain.ads: Initial version.

	* prj-attr.adb (Initialisation_Data): Add package Gnatstub.

	* snames.adb: Updated to match snames.ads.

	* snames.ads: Added Gnatstub.

	* prj-attr.adb (Initialization_Data): Change name from
	Initialisation_Data.

	* g-regpat.adb (Parse_Literal): Properly handle simple operators ?,
	+ and * applied to backslashed expressions like \r.

	* g-os_lib.ads: String_List type added, Argument_List type is now
	subtype of String_List.

	* g-os_lib.ads: Change copyright to FSF
	Add comments for String_List type

	* g-dirope.adb (Expand_Path): Fix bug. (wrong length when adding a
	string to the buffer).


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@47905 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 594 insertions, 0 deletions

diff --git a/gcc/ada/gnatmain.adb b/gcc/ada/gnatmain.adb
new file mode 100644
index 00000000000..0903f516175
--- /dev/null
+++ b/gcc/ada/gnatmain.adb
@@ -0,0 +1,594 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                            G N A T M A I N                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          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 occurence 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;