--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
OSDN Git Service
