+2011-08-29 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch9.adb, mlib-prj.adb, prj.adb, prj.ads, ttypes.ads, sem_ch4.adb,
+ makeutl.adb, makeutl.ads, atree.ads, snames.adb-tmpl,
+ snames.ads-tmpl: Minor reformatting.
+
2011-08-29 Philippe Gil <gil@adacore.com>
* prj.adb (Reset_Units_In_Table): New procedure.
-- Source to be Empty, in which case Relocate_Node simply returns
-- Empty as the result.
- function Copy_Separate_List (Source : List_Id) return List_Id;
- -- Apply the following to a list of nodes
-
function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Separate_Tree copies
-- the entire syntactic subtree, including recursively any descendants
-- However, to ensure that no entities are shared between the two when the
-- source is already analyzed, entity fields in the copy are zeroed out.
+ function Copy_Separate_List (Source : List_Id) return List_Id;
+ -- Applies Copy_Separate_Tree to each element of the Source list, returning
+ -- a new list of the results of these copy operations.
+
procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id);
-- Exchange the contents of two entities. The parent pointers are switched
-- as well as the Defining_Identifier fields in the parents, so that the
-- end if;
-- end if;
-- end;
- --
- -- The triggering statement and the timed statements have not been
- -- analyzed yet (see Analyzed_Timed_Entry_Call). They may contain local
- -- declarations, and therefore the copies that are made during expansion
- -- must be disjoint, as for any other inlining.
+
+ -- The triggering statement and the sequence of timed statements have not
+ -- been analyzed yet (see Analyzed_Timed_Entry_Call). They may contain
+ -- local declarations, and therefore the copies that are made during
+ -- expansion must be disjoint, as for any other inlining.
procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
---------------------
procedure Write_Path_File (FD : File_Descriptor) is
- Last : Natural;
+ Last : Natural;
Status : Boolean;
+
begin
Name_Len := 0;
if Last = Name_Len then
Close (FD, Status);
-
else
Status := False;
end if;
No_Names : constant Name_Ids := (1 .. 0 => No_Name);
-- Name_Ids is used for list of language names in procedure Get_Directories
-- below.
+
Ada_Only : constant Name_Ids := (1 => Name_Ada);
-- Used to invoke Get_Directories in gnatmake
Write_Path_File (Path_FD);
Path_FD := Invalid_FD;
-
end if;
if Current_Source_Path_File_Of (In_Tree.Shared) /=
- For_Project.Include_Path_File
+ For_Project.Include_Path_File
then
Set_Current_Source_Path_File_Of
- (In_Tree.Shared,
- For_Project.Include_Path_File);
+ (In_Tree.Shared, For_Project.Include_Path_File);
Set_Path_File_Var
(Project_Include_Path_File,
Get_Name_String (For_Project.Include_Path_File));
declare
Path_File_Name : Path_Name_Type;
+
begin
Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name);
Path_FD := Invalid_FD;
Set_Path_File_Var
- (Project_Objects_Path_File,
- Get_Name_String (Path_File_Name));
+ (Project_Objects_Path_File, Get_Name_String (Path_File_Name));
Set_Current_Source_Path_File_Of
(In_Tree.Shared, Path_File_Name);
end;
Arguments (1 .. Argument_Number),
Success);
- else
- -- Otherwise create a temporary response file
+ -- Otherwise create a temporary response file
+ else
declare
FD : File_Descriptor;
Path : Path_Name_Type;
-- Free memory allocated for the list of languages or sources
procedure Reset_Units_In_Table (Table : in out Units_Htable.Instance);
- -- reset to No_Unit_Index Unit.File_Names (Spec).Unit &
- -- Unit.File_Names (Impl).Unit for all Unis of the Table
+ -- Resets all Units to No_Unit_Index Unit.File_Names (Spec).Unit &
+ -- Unit.File_Names (Impl).Unit in the given table.
procedure Free_Units (Table : in out Units_Htable.Instance);
-- Free memory allocated for unit information in the project
---------------------------------
function Current_Object_Path_File_Of
- (Shared : Shared_Project_Tree_Data_Access)
- return Path_Name_Type is
+ (Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type
+ is
begin
return Shared.Private_Part.Current_Object_Path_File;
end Current_Object_Path_File_Of;
Unit := Units_Htable.Get_Next (Table);
end loop;
-
end Reset_Units_In_Table;
----------------
Unit := Units_Htable.Get_First (Table);
while Unit /= No_Unit_Index loop
- -- we cannot reset Unit.File_Names (Impl or Spec).Unit here as
+ -- We cannot reset Unit.File_Names (Impl or Spec).Unit here as
-- Source_Data buffer is freed by the following instruction
-- Free_List (Tree.Projects, Free_Project => True);
-- Call Setenv, after calling To_Host_File_Spec
function Current_Source_Path_File_Of
- (Shared : Shared_Project_Tree_Data_Access)
- return Path_Name_Type;
+ (Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type;
-- Get the current include path file name
procedure Set_Current_Source_Path_File_Of
-- Record the current include path file name
function Current_Object_Path_File_Of
- (Shared : Shared_Project_Tree_Data_Access)
- return Path_Name_Type;
+ (Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type;
-- Get the current object path file name
procedure Set_Current_Object_Path_File_Of
-- resolved will simply be ignored. However, in such a case, the flag
-- Incomplete_With in the project tree will be set to True.
-- This is meant for use by tools so that they can properly set the
- -- project path in such a case:Shared_
+ -- project path in such a case:
-- * no "gnatls" found (so no default project path)
-- * user project sets Project.IDE'gnatls attribute to a cross gnatls
-- * user project also includes a "with" that can only be resolved
-- Ada 2012 (AI05-0111-3): Analyze the subpool_specification, if
-- any. The expected type for the name is any type. A non-overloading
-- rule then requires it to be of a type descended from
- -- System.Storage_Pools.Subpools.Subpool_Handle. This isn't exactly what
- -- the AI says, but I think it's the right rule. The AI should be fixed.
+ -- System.Storage_Pools.Subpools.Subpool_Handle.
+
+ -- This isn't exactly what the AI says, but it seems to be the right
+ -- rule. The AI should be fixed.???
declare
Subpool : constant Node_Id := Subpool_Handle_Name (N);
+
begin
if Present (Subpool) then
Analyze (Subpool);
+
if Is_Overloaded (Subpool) then
Error_Msg_N ("ambiguous subpool handle", Subpool);
end if;
- -- ???We need to check that Etype (Subpool) is descended from
- -- Subpool_Handle
+ -- Check that Etype (Subpool) is descended from Subpool_Handle
Resolve (Subpool);
end if;
Find_Type (Subtype_Mark (E));
-- Analyze the qualified expression, and apply the name resolution
- -- rule given in 4.7 (3).
+ -- rule given in 4.7(3).
Analyze (E);
Type_Id := Etype (E);
function Is_Attribute_Name (N : Name_Id) return Boolean is
begin
+ -- Don't consider Name_Elab_Subp_Body to be a valid attribute name
+ -- unless we are working in CodePeer mode.
+
return N in First_Attribute_Name .. Last_Attribute_Name
and then (CodePeer_Mode or else N /= Name_Elab_Subp_Body);
end Is_Attribute_Name;
-- Remaining attributes are ones that return entities
+ -- Note that Elab_Subp_Body is not considered to be a valid attribute
+ -- name unless we are operating in CodePeer mode.
+
First_Entity_Attribute_Name : constant Name_Id := N + $;
Name_Elab_Body : constant Name_Id := N + $; -- GNAT
Name_Elab_Spec : constant Name_Id := N + $; -- GNAT
-- Called to initialize the preset names in the names table
function Is_Attribute_Name (N : Name_Id) return Boolean;
- -- Test to see if the name N is the name of a recognized attribute
+ -- Test to see if the name N is the name of a recognized attribute. Note
+ -- that Name_Elab_Subp_Body returns False if not operating in CodePeer
+ -- mode. This is the mechanism for considering this pragma illegal in
+ -- normal GNAT programs.
function Is_Entity_Attribute_Name (N : Name_Id) return Boolean;
-- Test to see if the name N is the name of a recognized entity attribute,
-- example, on some machines, Short_Float may be the same as Float, and
-- Long_Long_Float may be the same as Long_Float.
- Standard_Short_Short_Integer_Size : constant Pos := Get_Char_Size;
- Standard_Short_Short_Integer_Width : constant Pos :=
- Width_From_Size (Standard_Short_Short_Integer_Size);
-
- Standard_Short_Integer_Size : constant Pos := Get_Short_Size;
- Standard_Short_Integer_Width : constant Pos :=
- Width_From_Size (Standard_Short_Integer_Size);
-
- Standard_Integer_Size : constant Pos := Get_Int_Size;
- Standard_Integer_Width : constant Pos :=
- Width_From_Size (Standard_Integer_Size);
-
- Standard_Long_Integer_Size : constant Pos := Get_Long_Size;
- Standard_Long_Integer_Width : constant Pos :=
- Width_From_Size (Standard_Long_Integer_Size);
-
- Standard_Long_Long_Integer_Size : constant Pos := Get_Long_Long_Size;
- Standard_Long_Long_Integer_Width : constant Pos :=
- Width_From_Size (Standard_Long_Long_Integer_Size);
-
- Standard_Short_Float_Size : constant Pos := Get_Float_Size;
- Standard_Short_Float_Digits : constant Pos :=
- Digits_From_Size (Standard_Short_Float_Size);
-
- Standard_Float_Size : constant Pos := Get_Float_Size;
- Standard_Float_Digits : constant Pos :=
- Digits_From_Size (Standard_Float_Size);
-
- Standard_Long_Float_Size : constant Pos := Get_Double_Size;
- Standard_Long_Float_Digits : constant Pos :=
- Digits_From_Size (Standard_Long_Float_Size);
-
- Standard_Long_Long_Float_Size : constant Pos := Get_Long_Double_Size;
- Standard_Long_Long_Float_Digits : constant Pos :=
- Digits_From_Size (Standard_Long_Long_Float_Size);
-
- Standard_Character_Size : constant Pos := Get_Char_Size;
-
- Standard_Wide_Character_Size : constant Pos := 16;
- Standard_Wide_Wide_Character_Size : constant Pos := 32;
+ Standard_Short_Short_Integer_Size : constant Pos := Get_Char_Size;
+ Standard_Short_Short_Integer_Width : constant Pos :=
+ Width_From_Size
+ (Standard_Short_Short_Integer_Size);
+
+ Standard_Short_Integer_Size : constant Pos := Get_Short_Size;
+ Standard_Short_Integer_Width : constant Pos :=
+ Width_From_Size
+ (Standard_Short_Integer_Size);
+
+ Standard_Integer_Size : constant Pos := Get_Int_Size;
+ Standard_Integer_Width : constant Pos :=
+ Width_From_Size
+ (Standard_Integer_Size);
+
+ Standard_Long_Integer_Size : constant Pos := Get_Long_Size;
+ Standard_Long_Integer_Width : constant Pos :=
+ Width_From_Size
+ (Standard_Long_Integer_Size);
+
+ Standard_Long_Long_Integer_Size : constant Pos := Get_Long_Long_Size;
+ Standard_Long_Long_Integer_Width : constant Pos :=
+ Width_From_Size
+ (Standard_Long_Long_Integer_Size);
+
+ Standard_Short_Float_Size : constant Pos := Get_Float_Size;
+ Standard_Short_Float_Digits : constant Pos :=
+ Digits_From_Size
+ (Standard_Short_Float_Size);
+
+ Standard_Float_Size : constant Pos := Get_Float_Size;
+ Standard_Float_Digits : constant Pos :=
+ Digits_From_Size
+ (Standard_Float_Size);
+
+ Standard_Long_Float_Size : constant Pos := Get_Double_Size;
+ Standard_Long_Float_Digits : constant Pos :=
+ Digits_From_Size
+ (Standard_Long_Float_Size);
+
+ Standard_Long_Long_Float_Size : constant Pos := Get_Long_Double_Size;
+ Standard_Long_Long_Float_Digits : constant Pos :=
+ Digits_From_Size
+ (Standard_Long_Long_Float_Size);
+
+ Standard_Character_Size : constant Pos := Get_Char_Size;
+
+ Standard_Wide_Character_Size : constant Pos := 16;
+ Standard_Wide_Wide_Character_Size : constant Pos := 32;
-- Standard wide character sizes
-- Note: there is no specific control over the representation of
----------------------------------------
Maximum_Alignment : constant Pos := Get_Maximum_Alignment;
- -- The maximum alignment, in storage units, that an object or
- -- type may require on the target machine.
+ -- The maximum alignment, in storage units, that an object or type may
+ -- require on the target machine.
System_Allocator_Alignment : constant Pos :=
- Get_System_Allocator_Alignment;
- -- The alignment, in storage units, of addresses returned by malloc.
+ Get_System_Allocator_Alignment;
+ -- The alignment in storage units of addresses returned by malloc
Max_Unaligned_Field : constant Pos := Get_Max_Unaligned_Field;
-- The maximum supported size in bits for a field that is not aligned
projects / thirdparty / gcc.git / commitdiff
