mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-22 11:41:07 +08:00
Code Issues Packages Projects Releases Wiki Activity

gnatmain.adb: Initial version.

Browse Source 
* 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
This commit is contained in:
Geert Bosch 2001-12-12 00:14:07 +01:00
parent 0d7839daee
commit 598c344654
9 changed files with 712 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
gcc/ada/ChangeLog
View File

@ -1,3 +1,40 @@
2001-12-11 Vincent Celier <celier@gnat.com>
* 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 <celier@gnat.com>
* prj-attr.adb (Initialization_Data): Change name from
Initialisation_Data.
2001-12-11 Emmanuel Briot <briot@gnat.com>
* g-regpat.adb (Parse_Literal): Properly handle simple operators ?,
+ and * applied to backslashed expressions like \r.
2001-12-11 Vasiliy Fofanov <fofanov@gnat.com>
* g-os_lib.ads: String_List type added, Argument_List type is now
subtype of String_List.
2001-12-11 Robert Dewar <dewar@gnat.com>
* g-os_lib.ads: Change copyright to FSF
Add comments for String_List type
2001-12-11 Vincent Celier <celier@gnat.com>
* g-dirope.adb (Expand_Path): Fix bug. (wrong length when adding a
string to the buffer).
2001-12-11 Ed Schonberg <schonber@gnat.com>
* freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in

4
gcc/ada/g-dirope.adb
View File

@ -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;
------------------------

13
gcc/ada/g-os_lib.ads
View File

@ -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.

20
gcc/ada/g-regpat.adb
View File

@ -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

594
gcc/ada/gnatmain.adb Normal file
View File

@ -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;

38
gcc/ada/gnatmain.ads Normal file
View File

@ -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;

27
gcc/ada/prj-attr.adb
View File

@ -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;

1
gcc/ada/snames.adb
View File

@ -595,6 +595,7 @@ package body Snames is
"binder#" &
"linker#" &
"compiler#" &
"gnatstub#" &
"#";
---------------------

3
gcc/ada/snames.ads
View File

@ -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;