From 598c344654d8f0119bd38977cb22898c48ec83bb Mon Sep 17 00:00:00 2001 From: Geert Bosch Date: Wed, 12 Dec 2001 00:14:07 +0100 Subject: [PATCH] gnatmain.adb: Initial version. * 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). From-SVN: r47905 --- gcc/ada/ChangeLog | 37 +++ gcc/ada/g-dirope.adb | 4 +- gcc/ada/g-os_lib.ads | 13 +- gcc/ada/g-regpat.adb | 20 +- gcc/ada/gnatmain.adb | 594 +++++++++++++++++++++++++++++++++++++++++++ gcc/ada/gnatmain.ads | 38 +++ gcc/ada/prj-attr.adb | 27 +- gcc/ada/snames.adb | 1 + gcc/ada/snames.ads | 3 +- 9 files changed, 712 insertions(+), 25 deletions(-) create mode 100644 gcc/ada/gnatmain.adb create mode 100644 gcc/ada/gnatmain.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5f65705ee64..a1f25891116 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,40 @@ +2001-12-11 Vincent Celier + + * 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. + +2001-12-11 Vincent Celier + + * prj-attr.adb (Initialization_Data): Change name from + Initialisation_Data. + +2001-12-11 Emmanuel Briot + + * g-regpat.adb (Parse_Literal): Properly handle simple operators ?, + + and * applied to backslashed expressions like \r. + +2001-12-11 Vasiliy Fofanov + + * g-os_lib.ads: String_List type added, Argument_List type is now + subtype of String_List. + +2001-12-11 Robert Dewar + + * g-os_lib.ads: Change copyright to FSF + Add comments for String_List type + +2001-12-11 Vincent Celier + + * g-dirope.adb (Expand_Path): Fix bug. (wrong length when adding a + string to the buffer). + 2001-12-11 Ed Schonberg * freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in diff --git a/gcc/ada/g-dirope.adb b/gcc/ada/g-dirope.adb index 7d212e8c71b..4755584168d 100644 --- a/gcc/ada/g-dirope.adb +++ b/gcc/ada/g-dirope.adb @@ -253,8 +253,8 @@ package body GNAT.Directory_Operations is Double_Result_Size; end loop; - Result (Result_Last + 1 .. Result_Last + S'Length - 1) := S; - Result_Last := Result_Last + S'Length - 1; + Result (Result_Last + 1 .. Result_Last + S'Length) := S; + Result_Last := Result_Last + S'Length; end Append; ------------------------ diff --git a/gcc/ada/g-os_lib.ads b/gcc/ada/g-os_lib.ads index 07fd8f1b83f..761e01904de 100644 --- a/gcc/ada/g-os_lib.ads +++ b/gcc/ada/g-os_lib.ads @@ -6,9 +6,9 @@ -- -- -- S p e c -- -- -- --- $Revision: 1.79 $ +-- $Revision$ -- -- --- Copyright (C) 1995-2001 Ada Core Technologies, Inc. -- +-- Copyright (C) 1995-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- -- @@ -56,10 +56,15 @@ package GNAT.OS_Lib is pragma Elaborate_Body (OS_Lib); type String_Access is access all String; + -- General purpose string access type procedure Free is new Unchecked_Deallocation (Object => String, Name => String_Access); + type String_List is array (Positive range <>) of String_Access; + type String_List_Access is access all String_List; + -- General purpose array and pointer for list of string accesses + --------------------- -- Time/Date Stuff -- --------------------- @@ -381,12 +386,12 @@ pragma Elaborate_Body (OS_Lib); -- Subprocesses -- ------------------ - type Argument_List is array (Positive range <>) of String_Access; + subtype Argument_List is String_List; -- Type used for argument list in call to Spawn. The lower bound -- of the array should be 1, and the length of the array indicates -- the number of arguments. - type Argument_List_Access is access all Argument_List; + subtype Argument_List_Access is String_List_Access; -- Type used to return an Argument_List without dragging in secondary -- stack. diff --git a/gcc/ada/g-regpat.adb b/gcc/ada/g-regpat.adb index f36d5bf9ffc..ab1b69c79d0 100644 --- a/gcc/ada/g-regpat.adb +++ b/gcc/ada/g-regpat.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.31 $ +-- $Revision$ -- -- -- Copyright (C) 1986 by University of Toronto. -- -- Copyright (C) 1996-2001 Ada Core Technologies, Inc. -- @@ -1563,6 +1563,7 @@ package body GNAT.Regpat is Start_Pos : Natural := 0; C : Character; Length_Ptr : Pointer; + Has_Special_Operator : Boolean := False; begin Parse_Pos := Parse_Pos - 1; -- Look at current character @@ -1585,6 +1586,7 @@ package body GNAT.Regpat is when '.' | '[' | '(' | ')' | '|' | ASCII.LF | '$' | '^' => if Start_Pos = 0 then + Start_Pos := Parse_Pos; Emit (C); -- First character is always emitted else exit Parse_Loop; -- Else we are done @@ -1593,12 +1595,14 @@ package body GNAT.Regpat is when '?' | '+' | '*' | '{' => if Start_Pos = 0 then + Start_Pos := Parse_Pos; Emit (C); -- First character is always emitted -- Are we looking at an operator, or is this -- simply a normal character ? elsif not Is_Mult (Parse_Pos) then - Case_Emit (C); + Start_Pos := Parse_Pos; + Case_Emit (C); else -- We've got something like "abc?d". Mark this as a -- special case. What we want to emit is a first @@ -1606,11 +1610,12 @@ package body GNAT.Regpat is -- ultimately be transformed with a CURLY operator, A -- special case has to be handled for "a?", since there -- is no initial string to emit. - Start_Pos := Natural'Last; + Has_Special_Operator := True; exit Parse_Loop; end if; when '\' => + Start_Pos := Parse_Pos; if Parse_Pos = Parse_End then Fail ("Trailing \"); else @@ -1629,12 +1634,13 @@ package body GNAT.Regpat is Parse_Pos := Parse_Pos + 1; end if; - when others => Case_Emit (C); + when others => + Start_Pos := Parse_Pos; + Case_Emit (C); end case; exit Parse_Loop when Emit_Ptr - Length_Ptr = 254; - Start_Pos := Parse_Pos; Parse_Pos := Parse_Pos + 1; exit Parse_Loop when Parse_Pos > Parse_End; @@ -1643,11 +1649,11 @@ package body GNAT.Regpat is -- Is the string followed by a '*+?{' operator ? If yes, and if there -- is an initial string to emit, do it now. - if Start_Pos = Natural'Last + if Has_Special_Operator and then Emit_Ptr >= Length_Ptr + 3 then Emit_Ptr := Emit_Ptr - 1; - Parse_Pos := Parse_Pos - 1; + Parse_Pos := Start_Pos; end if; if Emit_Code then 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; diff --git a/gcc/ada/gnatmain.ads b/gcc/ada/gnatmain.ads new file mode 100644 index 00000000000..5f81d8f9c1f --- /dev/null +++ b/gcc/ada/gnatmain.ads @@ -0,0 +1,38 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T M A I N -- +-- -- +-- S p e c -- +-- -- +-- $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). -- +-- -- +------------------------------------------------------------------------------ + +-- This procedure is the project-aware driver for the GNAT tools. +-- For gnatls, gnatxref, gnatfind and gnatstub, it setup the environment +-- variables ADA_INCLUDE_PATH and ADA_OBJECT_PATH and gather the switches +-- and file names from the project file (if any) and from the common line, +-- then call the non project-aware tool (gnatls, gnatxref, gnatfind or +-- gnatstub). +-- For other tools (compiler, binder, linker, gnatmake), it invokes +-- gnatmake with the proper switches. + +procedure Gnatmain; diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 775160c3400..6710f2119df 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -49,7 +49,7 @@ package body Prj.Attr is -- End is indicated by two consecutive '#'. - Initialisation_Data : constant String := + Initialization_Data : constant String := -- project attributes @@ -121,6 +121,11 @@ package body Prj.Attr is "Ladefault_switches#" & "LAswitches#" & + -- package Gnatstub + + "Pgnatstub#" & + "LVswitches#" & + "#"; ---------------- @@ -128,7 +133,7 @@ package body Prj.Attr is ---------------- procedure Initialize is - Start : Positive := Initialisation_Data'First; + Start : Positive := Initialization_Data'First; Finish : Positive := Start; Current_Package : Package_Node_Id := Empty_Package; Current_Attribute : Attribute_Node_Id := Empty_Attribute; @@ -145,9 +150,9 @@ package body Prj.Attr is Attributes.Set_Last (Attributes.First); Package_Attributes.Set_Last (Package_Attributes.First); - while Initialisation_Data (Start) /= '#' loop + while Initialization_Data (Start) /= '#' loop Is_An_Attribute := True; - case Initialisation_Data (Start) is + case Initialization_Data (Start) is when 'P' => -- New allowed package @@ -155,19 +160,19 @@ package body Prj.Attr is Start := Start + 1; Finish := Start; - while Initialisation_Data (Finish) /= '#' loop + while Initialization_Data (Finish) /= '#' loop Finish := Finish + 1; end loop; Name_Len := Finish - Start; Name_Buffer (1 .. Name_Len) := - To_Lower (Initialisation_Data (Start .. Finish - 1)); + To_Lower (Initialization_Data (Start .. Finish - 1)); Package_Name := Name_Find; for Index in Package_First .. Package_Attributes.Last loop if Package_Name = Package_Attributes.Table (Index).Name then Write_Line ("Duplicate package name """ & - Initialisation_Data (Start .. Finish - 1) & + Initialization_Data (Start .. Finish - 1) & """ in Prj.Attr body."); raise Program_Error; end if; @@ -196,7 +201,7 @@ package body Prj.Attr is -- New attribute Start := Start + 1; - case Initialisation_Data (Start) is + case Initialization_Data (Start) is when 'V' => Kind_2 := Single; when 'A' => @@ -210,13 +215,13 @@ package body Prj.Attr is Start := Start + 1; Finish := Start; - while Initialisation_Data (Finish) /= '#' loop + while Initialization_Data (Finish) /= '#' loop Finish := Finish + 1; end loop; Name_Len := Finish - Start; Name_Buffer (1 .. Name_Len) := - To_Lower (Initialisation_Data (Start .. Finish - 1)); + To_Lower (Initialization_Data (Start .. Finish - 1)); Attribute_Name := Name_Find; Attributes.Increment_Last; if Current_Attribute = Empty_Attribute then @@ -234,7 +239,7 @@ package body Prj.Attr is if Attribute_Name = Attributes.Table (Index).Name then Write_Line ("Duplicate attribute name """ & - Initialisation_Data (Start .. Finish - 1) & + Initialization_Data (Start .. Finish - 1) & """ in Prj.Attr body."); raise Program_Error; end if; diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 1464acd9afd..d72b0b8f1ca 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -595,6 +595,7 @@ package body Snames is "binder#" & "linker#" & "compiler#" & + "gnatstub#" & "#"; --------------------- diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 5c9ba3ca4d7..f56403f1282 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -894,10 +894,11 @@ package Snames is Name_Binder : constant Name_Id := N + 549; Name_Linker : constant Name_Id := N + 550; Name_Compiler : constant Name_Id := N + 551; + Name_Gnatstub : constant Name_Id := N + 552; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 551; + Last_Predefined_Name : constant Name_Id := N + 552; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; -- 2.30.2