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

exp_ch9.adb, [...]: Minor reformatting. 

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.

From-SVN: r178179
This commit is contained in:
Robert Dewar 2011-08-29 09:34:19 +00:00 committed by Arnaud Charlet
parent 3e37be71aa
commit f0f88eb6da
12 changed files with 93 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -1,3 +1,9 @@
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.

7
gcc/ada/atree.ads
View File

@ -429,9 +429,6 @@ package Atree is
-- 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
@ -444,6 +441,10 @@ package Atree is
-- 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

10
gcc/ada/exp_ch9.adb
View File

@ -10990,11 +10990,11 @@ package body Exp_Ch9 is
-- 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);

4
gcc/ada/makeutl.adb
View File

@ -3324,8 +3324,9 @@ package body Makeutl is
---------------------
procedure Write_Path_File (FD : File_Descriptor) is
Last : Natural;
Last : Natural;
Status : Boolean;
begin
Name_Len := 0;
@ -3338,7 +3339,6 @@ package body Makeutl is
if Last = Name_Len then
Close (FD, Status);
else
Status := False;
end if;

1
gcc/ada/makeutl.ads
View File

@ -175,6 +175,7 @@ package Makeutl is
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

14
gcc/ada/mlib-prj.adb
View File

@ -1062,15 +1062,13 @@ package body MLib.Prj is
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));
@ -1086,6 +1084,7 @@ package body MLib.Prj is
declare
Path_File_Name : Path_Name_Type;
begin
Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name);
@ -1093,8 +1092,7 @@ package body MLib.Prj is
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;
@ -1116,9 +1114,9 @@ package body MLib.Prj is
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;

11
gcc/ada/prj.adb
View File

@ -72,8 +72,8 @@ package body Prj is
-- 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
@ -123,8 +123,8 @@ package body Prj is
---------------------------------
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;
@ -965,7 +965,6 @@ package body Prj is
Unit := Units_Htable.Get_Next (Table);
end loop;
end Reset_Units_In_Table;
----------------
@ -982,7 +981,7 @@ package body Prj is
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);

8
gcc/ada/prj.ads
View File

@ -1599,8 +1599,7 @@ package Prj is
-- 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
@ -1609,8 +1608,7 @@ package Prj is
-- 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
@ -1699,7 +1697,7 @@ package Prj is
-- 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

13
gcc/ada/sem_ch4.adb
View File

@ -446,20 +446,23 @@ package body Sem_Ch4 is
-- 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;
@ -473,7 +476,7 @@ package body Sem_Ch4 is
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);

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

@ -306,6 +306,9 @@ package body Snames is
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;

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

@ -880,6 +880,9 @@ package Snames is
-- 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
@ -1714,7 +1717,10 @@ package Snames is
-- 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,

77
gcc/ada/ttypes.ads
View File

@ -102,46 +102,55 @@ package Ttypes is
-- 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_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_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_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_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_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_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_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_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_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_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_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
@ -185,12 +194,12 @@ package Ttypes is
----------------------------------------
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