diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/atree.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/makeutl.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/makeutl.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/snames.adb-tmpl | 3 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 8 | ||||
| -rw-r--r-- | gcc/ada/ttypes.ads | 97 |
12 files changed, 103 insertions, 79 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b28557c..04df953 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 e75a95f..4e20b0b 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 b0860bc..fc6751a 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 b347497..4b68280 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 f7eadac..ceb38bd 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 b01ad9d..9020705 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 e68b187..fc65860 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 131a45b..aa953b3 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 a6ec3a7..3696bbb 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 92b258d..d6c3851 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 ff114dc..53b4365 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 bf58eec..ef57187 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 |