summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-08-29 09:34:19 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-08-29 09:34:19 +0000
commit5a4d11b2bd5f068cfa47f8e959df9e02172e4fdc (patch)
tree4ddce1f125b1a2af8c3d5dd0c7454f02fe1040a4
parentd3bc144e6671af5f52e6edcfa50bc27e0593c615 (diff)
downloadgcc-5a4d11b2bd5f068cfa47f8e959df9e02172e4fdc.tar.gz
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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178179 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/atree.ads7
-rw-r--r--gcc/ada/exp_ch9.adb10
-rw-r--r--gcc/ada/makeutl.adb4
-rw-r--r--gcc/ada/makeutl.ads1
-rw-r--r--gcc/ada/mlib-prj.adb14
-rw-r--r--gcc/ada/prj.adb11
-rw-r--r--gcc/ada/prj.ads8
-rw-r--r--gcc/ada/sem_ch4.adb13
-rw-r--r--gcc/ada/snames.adb-tmpl3
-rw-r--r--gcc/ada/snames.ads-tmpl8
-rw-r--r--gcc/ada/ttypes.ads97
12 files changed, 103 insertions, 79 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b28557c68be..04df953f26a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index e75a95f5cf6..4e20b0b0f00 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -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
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index b0860bc0b96..fc6751a92e0 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -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);
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index b3474975dfe..4b6828041fb 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -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;
diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index f7eadacc603..ceb38bdf39f 100644
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -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
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index b01ad9d1ea2..9020705d49b 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -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;
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index e68b18786d5..fc65860aee2 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -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);
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 131a45b896b..aa953b35931 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -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
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index a6ec3a74b0d..3696bbb9bc8 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -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);
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index 92b258df923..d6c385183b4 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -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;
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index ff114dcd8a3..53b4365277f 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -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,
diff --git a/gcc/ada/ttypes.ads b/gcc/ada/ttypes.ads
index bf58eeca1ee..ef57187c6b2 100644
--- a/gcc/ada/ttypes.ads
+++ b/gcc/ada/ttypes.ads
@@ -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_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
@@ -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