diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/ada/binde.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sinput-l.ads | 2 |
7 files changed, 61 insertions, 26 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 81c3e14..168458f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2017-09-06 Gary Dismukes <dismukes@adacore.com> + + * sem_ch5.adb: Minor reformatting and a typo fix + +2017-09-06 Arnaud Charlet <charlet@adacore.com> + + * sinput-l.ads: minor remove extra period at the end of comment + +2017-09-06 Arnaud Charlet <charlet@adacore.com> + + * sem_prag.adb (Add_Item_To_Name_Buffer): remove support for + E_Discriminant. + (Find_Role): remove support for E_Discriminant. + +2017-09-06 Javier Miranda <miranda@adacore.com> + + * exp_ch6.adb (Expand_Simple_Function_Return): + Add missing implicit type conversion to force displacement of the + "this" pointer. + 2017-09-06 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch3.adb, sem_aux.adb, sem_res.adb: Minor reformatting. diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index 329c6ca..aab6e63 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -329,8 +329,10 @@ package body Binde is -- the reason for the link is R. Ea_Id is the contents to be placed in the -- Elab_All_Link of the entry. - procedure Choose (Elab_Order : in out Unit_Id_Table; Chosen : Unit_Id; - Msg : String); + procedure Choose + (Elab_Order : in out Unit_Id_Table; + Chosen : Unit_Id; + Msg : String); -- Chosen is the next entry chosen in the elaboration order. This procedure -- updates all data structures appropriately. @@ -985,8 +987,10 @@ package body Binde is -- Choose -- ------------ - procedure Choose (Elab_Order : in out Unit_Id_Table; Chosen : Unit_Id; - Msg : String) + procedure Choose + (Elab_Order : in out Unit_Id_Table; + Chosen : Unit_Id; + Msg : String) is pragma Assert (Chosen /= No_Unit_Id); S : Successor_Id; @@ -1087,6 +1091,7 @@ package body Binde is (Errors_Detected > 0 or else Num_Chosen = Last (Elab_Order)); pragma Assert (Units.Last = UNR.Last); pragma Assert (Num_Chosen + Num_Left = Int (UNR.Last)); + if Debug_Flag_C then Write_Str (" "); Write_Int (Int (Num_Chosen)); @@ -1113,8 +1118,10 @@ package body Binde is then null; else - Choose (Elab_Order, Corresponding_Body (Chosen), - " [Elaborate_Body]"); + Choose + (Elab_Order => Elab_Order, + Chosen => Corresponding_Body (Chosen), + Msg => " [Elaborate_Body]"); end if; end if; end Choose; @@ -1720,7 +1727,8 @@ package body Binde is if Pessimistic_Elab_Order or Debug_Flag_Old or Debug_Flag_Older then pragma Assert (Last (Elab_Order) = 0 - or else Last (Elab_Order) = Old_Order'Last); + or else Last (Elab_Order) = Old_Order'Last); + Init (Elab_Order); Append_All (Elab_Order, Old_Order); end if; @@ -3033,8 +3041,10 @@ package body Binde is end if; if Choose_The_Body then - Choose (Elab_Order, Corresponding_Body (Best_So_Far), - " [body]"); + Choose + (Elab_Order => Elab_Order, + Chosen => Corresponding_Body (Best_So_Far), + Msg => " [body]"); end if; end; end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 58ced47..d4f9475 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6429,6 +6429,16 @@ package body Exp_Ch6 is Rewrite (Exp, Duplicate_Subexpr_No_Checks (Exp)); + -- Ada 2005 (AI-251): If the type of the returned object is + -- an interface then add an implicit type conversion to force + -- displacement of the "this" pointer. + + if Is_Interface (R_Type) then + Rewrite (Exp, Convert_To (R_Type, Relocate_Node (Exp))); + end if; + + Analyze_And_Resolve (Exp, R_Type); + -- For controlled types, do the allocation on the secondary stack -- manually in order to call adjust at the right time: diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 66e8e85..c20beef 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4130,7 +4130,8 @@ package body Freeze is declare Comp_Type : constant Entity_Id := Etype (Comp); Comp_Size : constant Uint := RM_Size (Comp_Type); - SSU : constant Int := Ttypes.System_Storage_Unit; + SSU : constant Int := Ttypes.System_Storage_Unit; + begin Sized_Component_Total_RM_Size := Sized_Component_Total_RM_Size + Comp_Size; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 7c33e38..64c5dc7 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -580,17 +580,16 @@ package body Sem_Ch5 is Set_Assignment_Type (Lhs, T1); - -- If the target of the assignment is an entity of a mutable type - -- and the expression is a conditional expression, its alternatives - -- can be of different subtypes of the nominal type of the LHS, so - -- they must be resolved with the base type, given that their subtype - -- may differ frok that of the target mutable object. + -- If the target of the assignment is an entity of a mutable type and + -- the expression is a conditional expression, its alternatives can be + -- of different subtypes of the nominal type of the LHS, so they must be + -- resolved with the base type, given that their subtype may differ from + -- that of the target mutable object. if Is_Entity_Name (Lhs) - and then Ekind_In (Entity (Lhs), - E_Variable, - E_Out_Parameter, - E_In_Out_Parameter) + and then Ekind_In (Entity (Lhs), E_In_Out_Parameter, + E_Out_Parameter, + E_Variable) and then Is_Composite_Type (T1) and then not Is_Constrained (Etype (Entity (Lhs))) and then Nkind_In (Rhs, N_If_Expression, N_Case_Expression) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 1cea29aa..d0c4387 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -596,7 +596,6 @@ package body Sem_Prag is -- to the name buffer. The individual kinds are as follows: -- E_Abstract_State - "state" -- E_Constant - "constant" - -- E_Discriminant - "discriminant" -- E_Generic_In_Out_Parameter - "generic parameter" -- E_Generic_In_Parameter - "generic parameter" -- E_In_Parameter - "parameter" @@ -651,9 +650,6 @@ package body Sem_Prag is elsif Ekind (Item_Id) = E_Constant then Add_Str_To_Name_Buffer ("constant"); - elsif Ekind (Item_Id) = E_Discriminant then - Add_Str_To_Name_Buffer ("discriminant"); - elsif Ekind_In (Item_Id, E_Generic_In_Out_Parameter, E_Generic_In_Parameter) then @@ -1104,7 +1100,7 @@ package body Sem_Prag is else SPARK_Msg_N ("item must denote parameter, variable, state or " - & "current instance of concurren type", Item); + & "current instance of concurrent type", Item); end if; -- All other input/output items are illegal @@ -1238,7 +1234,6 @@ package body Sem_Prag is -- Constants elsif Ekind_In (Item_Id, E_Constant, - E_Discriminant, E_Loop_Parameter) then Item_Is_Input := True; diff --git a/gcc/ada/sinput-l.ads b/gcc/ada/sinput-l.ads index f4a3ccf..1507d88 100644 --- a/gcc/ada/sinput-l.ads +++ b/gcc/ada/sinput-l.ads @@ -67,7 +67,7 @@ package Sinput.L is function Source_File_Is_Body (X : Source_File_Index) return Boolean; -- Returns true if the designated source file contains a subprogram body -- or a package body. This is a limited scan just to determine the answer - -- to this question.. + -- to this question. function Source_File_Is_No_Body (X : Source_File_Index) return Boolean; -- Returns true if the designated source file contains pragma No_Body; |