+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.
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)
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);
"Sadriver#" &
"Larequired_switches#" &
+ "Lainitial_required_switches#" &
+ "Lafinal_required_switches#" &
"Lapic_option#" &
"Sapath_syntax#" &
"Saobject_file_suffix#" &
+ "Laobject_file_switches#" &
-- Configuration - Mapping files
-- 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 --
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);
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
exit;
else
-
-- If it is not the last element in the list, add to
-- new list.
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 :=
(Name,
"." & Path_Separator &
Prefix_Path & "share" & Directory_Separator & "gpr");
-
else
return Locate_Regular_File (Name, ".");
end if;
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;
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
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
function Might_Have_Sources (Project : Project_Id) return Boolean is
Variable : Variable_Value;
+
begin
Variable :=
Value_Of
return Variable = Nil_Variable_Value
or else Variable.Default
or else Variable.Values /= Nil_String;
+
else
return False;
end if;
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;
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));
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.
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);
Prj.Initialize (Project_Tree);
Prj.Tree.Initialize (Project_Node_Tree);
- Main_Project := No_Project;
+ Main_Project := No_Project;
Automatically_Generated := False;
Prj.Part.Parse
begin
Proj := Project_Tree.Projects;
-
while Proj /= null loop
if Proj.Project /= Config_File then
User_Decl := Proj.Project.Decl;
-- --
------------------------------------------------------------------------------
--- The following package manipulates the configuration files.
+-- The following package manipulates the configuration files
with Prj.Tree;
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;
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
-- 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
-- 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
-- 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.
--
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;
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_Initial_Required_Switches,
+ From_List => Element.Value.Values,
+ In_Tree => In_Tree);
+
+ when Name_Final_Required_Switches =>
Put (Into_List =>
- Lang_Index.Config.Compiler_Required_Switches,
+ Lang_Index.Config.
+ Compiler_Final_Required_Switches,
From_List => Element.Value.Values,
In_Tree => In_Tree);
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>)
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
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 :=
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
(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
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
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,
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);
-- 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;
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
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 --
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;
-- --
------------------------------------------------------------------------------
--- 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;
-- 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);
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 + $;
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 + $;
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 + $;
projects / gcc.git / commitdiff