OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2009-06-23  Robert Dewar  <dewar@adacore.com>

	* s-strhas.adb, s-strhas.ads: Restrict to 32-bit modular types

	* s-imgdec.adb (Set_Decimal_Digits): Fix error of too many digits for
	small values

	* prj-conf.ads: Minor reformatting

	* prj-conf.adb: Minor reformatting

2009-06-23  Vasiliy Fofanov  <fofanov@adacore.com>

	* g-debpoo.adb (Dump_Gnatmem): Output dummy timestamps for allocations
	to correspond to the log format that gnatmem now expects.

2009-06-23  Vincent Celier  <celier@adacore.com>

	* prj-attr.adb: New attributes Initial_Required_Switches,
	Final_Required_Switches and Object_File_Switches
	
	* prj-nmsc.adb (Process_Compiler): Process new attributes
	Name_Final_Required_Switches, Name_Initial_Required_Switches and
	Name_Object_File_Switches.

	* prj.ads (Language_Config): New component
	Compiler_Initial_Required_Switches (replace Compiler_Required_Switches),
	Compiler_Final_Required_Switches and Object_File_Switches.

	* snames.ads-tmpl: New standard names Initial_Required_Switches,
	Final_Required_Switches and Object_File_Switches

From-SVN: r148837
This commit is contained in:
Arnaud Charlet 2009-06-23 11:39:00 +02:00
parent 352620476c
commit f91c36dc88
11 changed files with 178 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/ada/ChangeLog
View File

@ -1,3 +1,35 @@
2009-06-23 Robert Dewar <dewar@adacore.com>
* s-strhas.adb, s-strhas.ads: Restrict to 32-bit modular types
* s-imgdec.adb (Set_Decimal_Digits): Fix error of too many digits for
small values
* prj-conf.ads: Minor reformatting
* prj-conf.adb: Minor reformatting
2009-06-23 Vasiliy Fofanov <fofanov@adacore.com>
* g-debpoo.adb (Dump_Gnatmem): Output dummy timestamps for allocations
to correspond to the log format that gnatmem now expects.
2009-06-23 Vincent Celier <celier@adacore.com>
* prj-attr.adb: New attributes Initial_Required_Switches,
Final_Required_Switches and Object_File_Switches
* prj-nmsc.adb (Process_Compiler): Process new attributes
Name_Final_Required_Switches, Name_Initial_Required_Switches and
Name_Object_File_Switches.
* prj.ads (Language_Config): New component
Compiler_Initial_Required_Switches (replace Compiler_Required_Switches),
Compiler_Final_Required_Switches and Object_File_Switches.
* snames.ads-tmpl: New standard names Initial_Required_Switches,
Final_Required_Switches and Object_File_Switches
2009-06-23 Pascal Obry <obry@adacore.com>
* s-strhas.adb, s-strhas.ads: Minor reformatting.

5
gcc/ada/g-debpoo.adb
View File

@ -1675,10 +1675,13 @@ package body GNAT.Debug_Pools is
Actual_Size : size_t;
Num_Calls : Integer;
Tracebk : Tracebacks_Array_Access;
Dummy_Time : Duration := 1.0;
begin
File := fopen (File_Name & ASCII.NUL, "wb" & ASCII.NUL);
fwrite ("GMEM DUMP" & ASCII.LF, 10, 1, File);
fwrite (Dummy_Time'Address, Duration'Max_Size_In_Storage_Elements, 1,
File);
-- List of not deallocated blocks (see Print_Info)
@ -1700,6 +1703,8 @@ package body GNAT.Debug_Pools is
fwrite (Current'Address, Address_Size, 1, File);
fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements, 1,
File);
fwrite (Dummy_Time'Address, Duration'Max_Size_In_Storage_Elements, 1,
File);
fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
File);

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

@ -173,9 +173,12 @@ package body Prj.Attr is
"Sadriver#" &
"Larequired_switches#" &
"Lainitial_required_switches#" &
"Lafinal_required_switches#" &
"Lapic_option#" &
"Sapath_syntax#" &
"Saobject_file_suffix#" &
"Laobject_file_switches#" &
-- Configuration - Mapping files

78
gcc/ada/prj-conf.adb
View File

@ -79,16 +79,16 @@ package body Prj.Conf is
-- found, or null otherwise
function Check_Target
(Config_File : Prj.Project_Id;
(Config_File : Prj.Project_Id;
Autoconf_Specified : Boolean;
Project_Tree : Prj.Project_Tree_Ref;
Target : String := "") return Boolean;
-- Check that the config file's target matches Target.
-- Target should be set to the empty string when the user did not specify
-- a target.
-- If the target in the configuration file is invalid, this function will
-- call Osint.Fail to report a fatal error message and stop the program.
-- Autoconf_Specified should be set to True if the user has used --autoconf
Project_Tree : Prj.Project_Tree_Ref;
Target : String := "") return Boolean;
-- Check that the config file's target matches Target. Target should be
-- set to the empty string when the user did not specify a target. If the
-- target in the configuration file is invalid, this function will call
-- Osint.Fail to report a fatal error message and stop the program.
-- Autoconf_Specified should be set to True if the user has used
-- autoconf.
--------------------
-- Add_Attributes --
@ -118,7 +118,6 @@ package body Prj.Conf is
begin
Conf_Attr_Id := Conf_Decl.Attributes;
User_Attr_Id := User_Decl.Attributes;
while Conf_Attr_Id /= No_Variable loop
Conf_Attr :=
Project_Tree.Variable_Elements.Table (Conf_Attr_Id);
@ -135,25 +134,22 @@ package body Prj.Conf is
Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
User_Attr;
elsif User_Attr.Value.Kind = List and then
Conf_Attr.Value.Values /= Nil_String
elsif User_Attr.Value.Kind = List
and then Conf_Attr.Value.Values /= Nil_String
then
-- List attribute declared in both the user project and the
-- configuration project: prepend the user list with the
-- configuration list.
declare
Conf_List : String_List_Id :=
Conf_Attr.Value.Values;
Conf_List : String_List_Id := Conf_Attr.Value.Values;
Conf_Elem : String_Element;
User_List : constant String_List_Id :=
User_Attr.Value.Values;
User_Attr.Value.Values;
New_List : String_List_Id;
New_Elem : String_Element;
begin
-- Create new list
String_Element_Table.Increment_Last
@ -187,7 +183,6 @@ package body Prj.Conf is
exit;
else
-- If it is not the last element in the list, add to
-- new list.
@ -269,10 +264,11 @@ package body Prj.Conf is
if Conf_List /= Nil_String then
declare
Link : constant String_List_Id :=
User_Array_Elem.Value.Values;
Link : constant String_List_Id :=
User_Array_Elem.Value.Values;
Previous : String_List_Id := Nil_String;
Next : String_List_Id;
begin
loop
Conf_List_Elem :=
@ -330,7 +326,6 @@ package body Prj.Conf is
(Name,
"." & Path_Separator &
Prefix_Path & "share" & Directory_Separator & "gpr");
else
return Locate_Regular_File (Name, ".");
end if;
@ -346,10 +341,12 @@ package body Prj.Conf is
Project_Tree : Prj.Project_Tree_Ref;
Target : String := "") return Boolean
is
Variable : constant Variable_Value :=
Value_Of (Name_Target, Config_File.Decl.Attributes, Project_Tree);
Variable : constant Variable_Value :=
Value_Of
(Name_Target, Config_File.Decl.Attributes, Project_Tree);
Tgt_Name : Name_Id := No_Name;
OK : Boolean;
begin
if Variable /= Nil_Variable_Value and then not Variable.Default then
Tgt_Name := Variable.Value;
@ -359,7 +356,7 @@ package body Prj.Conf is
OK := not Autoconf_Specified or Tgt_Name = No_Name;
else
OK := Tgt_Name /= No_Name
and then Target = Get_Name_String (Tgt_Name);
and then Target = Get_Name_String (Tgt_Name);
end if;
if not OK then
@ -423,7 +420,8 @@ package body Prj.Conf is
function Default_File_Name return String is
Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
Tmp : String_Access;
Tmp : String_Access;
begin
if Target_Name /= "" then
if Ada_RTS /= "" then
@ -459,6 +457,7 @@ package body Prj.Conf is
function Might_Have_Sources (Project : Project_Id) return Boolean is
Variable : Variable_Value;
begin
Variable :=
Value_Of
@ -478,6 +477,7 @@ package body Prj.Conf is
return Variable = Nil_Variable_Value
or else Variable.Default
or else Variable.Values /= Nil_String;
else
return False;
end if;
@ -497,11 +497,11 @@ package body Prj.Conf is
Equal => "=");
-- Hash table to keep the languages used in the project tree
IDE : constant Package_Id :=
Value_Of
(Name_Ide,
Project.Decl.Packages,
Project_Tree);
IDE : constant Package_Id :=
Value_Of
(Name_Ide,
Project.Decl.Packages,
Project_Tree);
Prj_Iter : Project_List;
List : String_List_Id;
@ -535,8 +535,8 @@ package body Prj.Conf is
Prj_Iter.Project.Decl.Attributes,
Project_Tree);
if Variable /= Nil_Variable_Value and then
not Variable.Default
if Variable /= Nil_Variable_Value
and then not Variable.Default
then
Get_Name_String (Variable.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
@ -574,16 +574,15 @@ package body Prj.Conf is
Name := Language_Htable.Get_First;
Count := 0;
while Name /= No_Name loop
Count := Count + 1;
Name := Language_Htable.Get_Next;
end loop;
Result := new String_List (1 .. Count);
Count := 1;
Name := Language_Htable.Get_First;
Count := 1;
Name := Language_Htable.Get_First;
while Name /= No_Name loop
-- Check if IDE'Compiler_Command is declared for the language.
-- If it is, use its value to invoke gprconfig.
@ -645,10 +644,14 @@ package body Prj.Conf is
procedure Do_Autoconf is
Obj_Dir : constant Variable_Value :=
Value_Of (Name_Object_Dir, Project.Decl.Attributes, Project_Tree);
Value_Of
(Name_Object_Dir,
Project.Decl.Attributes,
Project_Tree);
Gprconfig_Path : String_Access;
Success : Boolean;
begin
Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
@ -892,7 +895,7 @@ package body Prj.Conf is
Prj.Initialize (Project_Tree);
Prj.Tree.Initialize (Project_Node_Tree);
Main_Project := No_Project;
Main_Project := No_Project;
Automatically_Generated := False;
Prj.Part.Parse
@ -986,7 +989,6 @@ package body Prj.Conf is
begin
Proj := Project_Tree.Projects;
while Proj /= null loop
if Proj.Project /= Config_File then
User_Decl := Proj.Project.Decl;

12
gcc/ada/prj-conf.ads
View File

@ -24,7 +24,7 @@
-- --
------------------------------------------------------------------------------
-- The following package manipulates the configuration files.
-- The following package manipulates the configuration files
with Prj.Tree;
@ -35,8 +35,8 @@ package Prj.Conf is
Project_Tree : Prj.Project_Tree_Ref);
-- Hook called after the config file has been parsed. This lets the
-- application do last minute changes to it (GPS uses this to add the
-- default naming schemes for instance). At that point, the config file has
-- not been applied to the project yet.
-- default naming schemes for instance). At that point, the config file
-- has not been applied to the project yet.
procedure Parse_Project_And_Apply_Config
(Main_Project : out Prj.Project_Id;
@ -55,6 +55,7 @@ package Prj.Conf is
On_Load_Config : Config_File_Hook := null);
-- Find the main configuration project and parse the project tree rooted at
-- this configuration project.
--
-- If the processing fails, Main_Project is set to No_Project. If the error
-- happend while parsing the project itself (ie creating the tree),
-- User_Project_Node is also set to Empty_Node
@ -63,6 +64,7 @@ package Prj.Conf is
-- If this is the case, the config file might be (re)generated, as
-- appropriate, to match languages and target if the one specified doesn't
-- already match.
--
-- Normalized_Hostname is the host on which gprbuild is returned,
-- normalized so that we can more easily compare it with what is stored in
-- configuration files. It is used when the target is unspecified, although
@ -90,13 +92,16 @@ package Prj.Conf is
-- default configuration file is found, a new one will be automatically
-- generated if Allow_Automatic_Generation is true (otherwise an error
-- reported to the user via Osint.Fail).
--
-- On exit, Configuration_Project_Path is never null (if none could be
-- found, Os.Fail was called and the program exited anyway).
--
-- The choice and generation of a configuration file depends on several
-- attributes of the user's project file (given by the Project argument),
-- like the list of languages that must be supported. Project must
-- therefore have been partially processed (phase one of the processing
-- only).
--
-- Config_File_Name should be set to the name of the config file specified
-- by the user (either through gprbuild's --config or --autoconf switches).
-- In the latter case, Autoconf_Specified should be set to true, to
@ -104,6 +109,7 @@ package Prj.Conf is
-- and languages. This name can either be an absolute path, or the a base
-- name that will be searched in the default config file directories (which
-- depends on the installation path for the tools).
--
-- Target_Name is used to chose among several possibilities
-- the configuration file that will be used.
--

77
gcc/ada/prj-nmsc.adb
View File

@ -622,7 +622,7 @@ package body Prj.Nmsc is
Suffix : File_Name_Type) return Boolean
is
begin
if Suffix = No_File then
if Suffix = No_File or else Suffix = Empty_File then
return False;
end if;
@ -1427,9 +1427,18 @@ package body Prj.Nmsc is
Lang_Index.Config.Compiler_Driver :=
File_Name_Type (Element.Value.Value);
when Name_Required_Switches =>
when Name_Required_Switches |
Name_Initial_Required_Switches =>
Put (Into_List =>
Lang_Index.Config.Compiler_Required_Switches,
Lang_Index.Config.
Compiler_Initial_Required_Switches,
From_List => Element.Value.Values,
In_Tree => In_Tree);
when Name_Final_Required_Switches =>
Put (Into_List =>
Lang_Index.Config.
Compiler_Final_Required_Switches,
From_List => Element.Value.Values,
In_Tree => In_Tree);
@ -1460,6 +1469,12 @@ package body Prj.Nmsc is
Element.Value.Value;
end if;
when Name_Object_File_Switches =>
Put (Into_List =>
Lang_Index.Config.Object_File_Switches,
From_List => Element.Value.Values,
In_Tree => In_Tree);
when Name_Pic_Option =>
-- Attribute Compiler_Pic_Option (<language>)
@ -4112,28 +4127,6 @@ package body Prj.Nmsc is
end if;
end;
declare
Current : Array_Element_Id;
Element : Array_Element;
begin
Current := Project.Naming.Spec_Suffix;
while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current);
Get_Name_String (Element.Value.Value);
if Name_Len = 0 then
Error_Msg
(Project, In_Tree,
"Spec_Suffix cannot be empty",
Element.Value.Location);
end if;
In_Tree.Array_Elements.Table (Current) := Element;
Current := Element.Next;
end loop;
end;
-- Check Body_Suffix
declare
@ -4194,28 +4187,6 @@ package body Prj.Nmsc is
end if;
end;
declare
Current : Array_Element_Id;
Element : Array_Element;
begin
Current := Project.Naming.Body_Suffix;
while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current);
Get_Name_String (Element.Value.Value);
if Name_Len = 0 then
Error_Msg
(Project, In_Tree,
"Body_Suffix cannot be empty",
Element.Value.Location);
end if;
In_Tree.Array_Elements.Table (Current) := Element;
Current := Element.Next;
end loop;
end;
-- Get the exceptions, if any
Project.Naming.Specification_Exceptions :=
@ -6421,19 +6392,21 @@ package body Prj.Nmsc is
Suffix_Str : constant String := Get_Name_String (Suffix);
begin
if Suffix_Str'Length = 0 or else Index (Suffix_Str, ".") = 0 then
if Suffix_Str'Length = 0 then
return False;
elsif Index (Suffix_Str, ".") = 0 then
return True;
end if;
-- If dot replacement is a single dot, and first character of suffix is
-- also a dot
-- Case of dot replacement is a single dot, and first character of
-- suffix is also a dot.
if Get_Name_String (Dot_Replacement) = "."
and then Suffix_Str (Suffix_Str'First) = '.'
then
for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
-- If there is another dot
-- Case of following dot
if Suffix_Str (Index) = '.' then
@ -6784,7 +6757,7 @@ package body Prj.Nmsc is
(Source_List_File.Kind = Single,
"Source_List_File is not a single string");
-- If the user has specified a Sources attribute
-- If the user has specified a Source_Files attribute
if not Sources.Default then
if not Source_List_File.Default then

22
gcc/ada/prj.ads
View File

@ -419,15 +419,25 @@ package Prj is
Compiler_Driver_Path : String_Access := null;
-- The path name of the executable for the compiler of the language
Compiler_Required_Switches : Name_List_Index := No_Name_List;
-- The list of switches that are required as a minimum to invoke the
-- compiler driver.
Compiler_Initial_Required_Switches : Name_List_Index := No_Name_List;
-- The list of initial switches that are required as a minimum to invoke
-- the compiler driver.
Compiler_Final_Required_Switches : Name_List_Index := No_Name_List;
-- The list of final switches that are required as a minimum to invoke
-- the compiler driver.
Path_Syntax : Path_Syntax_Kind := Host;
-- Value may be Canonical (Unix style) or Host (host syntax, for example
-- on VMS for DEC C).
Object_File_Suffix : Name_Id := No_Name;
Object_File_Suffix : Name_Id := No_Name;
-- Optional alternate object file suffix
Object_File_Switches : Name_List_Index := No_Name_List;
-- Optional object file switches. When this is defined, the switches
-- are used to specify the object file. The object file name is appended
-- to the last switch in the list. Example: ("-o", "").
Compilation_PIC_Option : Name_List_Index := No_Name_List;
-- The option(s) to compile a source in Position Independent Code for
@ -543,9 +553,11 @@ package Prj is
Include_Compatible_Languages => No_Name_List,
Compiler_Driver => No_File,
Compiler_Driver_Path => null,
Compiler_Required_Switches => No_Name_List,
Compiler_Initial_Required_Switches => No_Name_List,
Compiler_Final_Required_Switches => No_Name_List,
Path_Syntax => Canonical,
Object_File_Suffix => No_Name,
Object_File_Switches => No_Name_List,
Compilation_PIC_Option => No_Name_List,
Object_Generated => True,
Objects_Linked => True,

33
gcc/ada/s-imgdec.adb
View File

@ -101,13 +101,14 @@ package body System.Img_Dec is
Expon : Integer;
-- Integer value of exponent
procedure Round (N : Natural);
procedure Round (N : Integer);
-- Round the number in Digs. N is the position of the last digit to be
-- retained in the rounded position (rounding is based on Digs (N + 1)
-- FD, LD, ND are reset as necessary if required. Note that if the
-- result value rounds up (e.g. 9.99 => 10.0), an extra digit can be
-- placed in the sign position as a result of the rounding, this is
-- the case in which FD is adjusted.
-- the case in which FD is adjusted. The call to Round has no effect
-- if N is outside the range FD .. LD.
procedure Set (C : Character);
pragma Inline (Set);
@ -131,11 +132,11 @@ package body System.Img_Dec is
-- Round --
-----------
procedure Round (N : Natural) is
procedure Round (N : Integer) is
D : Character;
begin
-- Nothing to do if rounding at or past last digit
-- Nothing to do if rounding past the last digit we have
if N >= LD then
return;
@ -318,9 +319,27 @@ package body System.Img_Dec is
Set_Blanks_And_Sign (Fore - 1);
Set ('0');
Set ('.');
Set_Zeroes (-Digits_Before_Point);
Set_Digits (FD, LD);
Set_Zeroes (Digits_After_Point - Scale);
declare
DA : Natural := Digits_After_Point;
-- Digits remaining to output after point
LZ : constant Integer :=
Integer'Max (0, Integer'Min (DA, -Digits_Before_Point));
-- Number of leading zeroes after point
begin
Set_Zeroes (LZ);
DA := DA - LZ;
if DA < ND then
Set_Digits (FD, FD + DA - 1);
else
Set_Digits (FD, LD);
Set_Zeroes (DA - ND);
end if;
end;
-- At least one digit before point in input

11
gcc/ada/s-strhas.adb
View File

@ -31,9 +31,8 @@
package body System.String_Hash is
-- Compute a hash value for a key. The approach here is follows
-- the algorithm used in GNU Awk and the ndbm substitute SDBM by
-- Ozan Yigit.
-- Compute a hash value for a key. The approach here is follows the
-- algorithm used in GNU Awk and the ndbm substitute SDBM by Ozan Yigit.
----------
-- Hash --
@ -41,6 +40,12 @@ package body System.String_Hash is
function Hash (Key : Key_Type) return Hash_Type is
pragma Compile_Time_Error
(Hash_Type'Modulus /= 2 ** 32
or else Hash_Type'First /= 0
or else Hash_Type'Last /= 2 ** 32 - 1,
"Hash_Type must be 32-bit modular with range 0 .. 2**32-1");
function Shift_Left
(Value : Hash_Type;
Amount : Natural) return Hash_Type;

17
gcc/ada/s-strhas.ads
View File

@ -29,13 +29,14 @@
-- --
------------------------------------------------------------------------------
-- This package provides a generic hashing function over strings,
-- suitable for use with a string keyed hash table.
-- This package provides a generic hashing function over strings, suitable for
-- use with a string keyed hash table. In particular, it is the basis for the
-- string hash functions in Ada.Containers.
--
-- The strategy used here is not appropriate for applications that
-- require cryptographically strong hashes, or for application which
-- wish to use very wide hash values as pseudo unique identifiers. In
-- such cases please refer to GNAT.SHA1 and GNAT.MD5.
-- The algorithm used here is not appropriate for applications that require
-- cryptographically strong hashes, or for application which wish to use very
-- wide hash values as pseudo unique identifiers. In such cases please refer
-- to GNAT.SHA1 and GNAT.MD5.
package System.String_Hash is
pragma Pure;
@ -48,7 +49,9 @@ package System.String_Hash is
-- The string type to use as a hash key
type Hash_Type is mod <>;
-- The type to be returned as a hash value
-- The type to be returned as a hash value. This must be a 32-bit
-- unsigned type with full range 0 .. 2**32-1, no other type is allowed
-- for this instantiation (checked in the body by Compile_Time_Error).
function Hash (Key : Key_Type) return Hash_Type;
pragma Inline (Hash);

3
gcc/ada/snames.ads-tmpl
View File

@ -1047,6 +1047,7 @@ package Snames is
Name_Executable_Suffix : constant Name_Id := N + $;
Name_Extends : constant Name_Id := N + $;
Name_Externally_Built : constant Name_Id := N + $;
Name_Final_Required_Switches : constant Name_Id := N + $;
Name_Finder : constant Name_Id := N + $;
Name_Global_Compilation_Switches : constant Name_Id := N + $;
Name_Global_Configuration_Pragmas : constant Name_Id := N + $;
@ -1062,6 +1063,7 @@ package Snames is
Name_Include_Path : constant Name_Id := N + $;
Name_Include_Path_File : constant Name_Id := N + $;
Name_Inherit_Source_Path : constant Name_Id := N + $;
Name_Initial_Required_Switches : constant Name_Id := N + $;
Name_Languages : constant Name_Id := N + $;
Name_Library : constant Name_Id := N + $;
Name_Library_Ali_Dir : constant Name_Id := N + $;
@ -1099,6 +1101,7 @@ package Snames is
Name_Naming : constant Name_Id := N + $;
Name_None : constant Name_Id := N + $;
Name_Object_File_Suffix : constant Name_Id := N + $;
Name_Object_File_Switches : constant Name_Id := N + $;
Name_Object_Generated : constant Name_Id := N + $;
Name_Object_List : constant Name_Id := N + $;
Name_Objects_Linked : constant Name_Id := N + $;