From 48bb06a77e71672e09f409b719b76c3388cc3b99 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 26 Oct 2015 14:27:48 +0100 Subject: [PATCH] [multiple changes] 2015-10-26 Hristian Kirtchev * exp_util.adb, sem_aux.adb, exp_attr.adb, sem_eval.adb: Minor reformatting. * sem_util.adb, sem_ch5.adb: Minor reformatting. 2015-10-26 Ed Schonberg * exp_unst.adb (Unnest_Subprogram): Add guard to prevent compiler abort when handling a reference to a formal in an aspect of a nested subprogram declaration as an uplevel reference. From-SVN: r229359 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/exp_attr.adb | 9 ++++----- gcc/ada/exp_unst.adb | 9 ++++++++- gcc/ada/exp_util.adb | 12 ++++++------ gcc/ada/sem_aux.adb | 2 +- gcc/ada/sem_ch5.adb | 7 ++++--- gcc/ada/sem_eval.adb | 8 +++++--- gcc/ada/sem_util.adb | 4 ++-- 8 files changed, 42 insertions(+), 21 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c4097993ea5..65f700c7341 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2015-10-26 Hristian Kirtchev + + * exp_util.adb, sem_aux.adb, exp_attr.adb, sem_eval.adb: Minor + reformatting. + * sem_util.adb, sem_ch5.adb: Minor reformatting. + +2015-10-26 Ed Schonberg + + * exp_unst.adb (Unnest_Subprogram): Add guard to prevent compiler + abort when handling a reference to a formal in an aspect of a + nested subprogram declaration as an uplevel reference. + 2015-10-26 Bob Duff * snames.ads-tmpl, aspects.adb, aspects.ads: Add the aspect and diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 51297ec4132..532dd273d51 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2999,9 +2999,8 @@ package body Exp_Attr is elsif Ekind (Entity (Pref)) = E_Constant and then Present (Renamed_Object (Entity (Pref))) - and then - Ekind (Entity (Renamed_Object (Entity (Pref)))) - = E_Enumeration_Literal + and then Ekind (Entity (Renamed_Object (Entity (Pref)))) = + E_Enumeration_Literal then Rewrite (N, Make_Integer_Literal (Loc, @@ -4987,8 +4986,8 @@ package body Exp_Attr is -- both cases the type of the first formal of their expanded -- subprogram is Address) - if Etype (First_Entity (Protected_Body_Subprogram (Subprg))) - = RTE (RE_Address) + if Etype (First_Entity (Protected_Body_Subprogram (Subprg))) = + RTE (RE_Address) then declare New_Itype : Entity_Id; diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index b555fe70561..689726bd919 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -496,7 +496,7 @@ package body Exp_Unst is -- We have a new uplevel referenced entity -- All we do at this stage is to add the uplevel reference to - -- the table. It's too earch to do anything else, since this + -- the table. It's too early to do anything else, since this -- uplevel reference may come from an unreachable subprogram -- in which case the entry will be deleted. @@ -798,6 +798,13 @@ package body Exp_Unst is S := URJ.Caller; loop S := Enclosing_Subprogram (S); + + -- if we are at the top level, as can happen with + -- references to formals in aspects of nested subprogram + -- declarations, there are no further subprograms to + -- mark as requiring activation records. + + exit when No (S); Subps.Table (Subp_Index (S)).Declares_AREC := True; exit when S = URJ.Callee; end loop; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index d546fa8d773..f2d7b59b18a 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6508,13 +6508,13 @@ package body Exp_Util is Expr : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Expr); - Nam : Name_Id; Arg_List : List_Id; + Nam : Name_Id; begin - -- If predicate checks are suppressed, then return a null statement. - -- For this call, we check only the scope setting. If the caller wants - -- to check a specific entity's setting, they must do it manually. + -- If predicate checks are suppressed, then return a null statement. For + -- this call, we check only the scope setting. If the caller wants to + -- check a specific entity's setting, they must do it manually. if Predicate_Checks_Suppressed (Empty) then return Make_Null_Statement (Loc); @@ -6548,8 +6548,8 @@ package body Exp_Util is Append_To (Arg_List, Make_Pragma_Argument_Association (Loc, Expression => - New_Copy_Tree (Expression - (Find_Aspect (Typ, Aspect_Predicate_Failure))))); + New_Copy_Tree + (Expression (Find_Aspect (Typ, Aspect_Predicate_Failure))))); end if; return diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index b7bf9f4d5c6..f704f93d5de 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -120,7 +120,7 @@ package body Sem_Aux is -- If there is an expression, return it elsif Present (Expression (D)) then - return (Expression (D)); + return Expression (D); -- For a constant, see if we have a full view diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 0c9c56e2e2e..418ff13edbb 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -316,10 +316,11 @@ package body Sem_Ch5 is Get_First_Interp (Lhs, I, It); while Present (It.Typ) loop + -- An indexed component with generalized indexing is always - -- overloaded with the corresponding dereference. Discard - -- the interpretation that yields a reference type, which - -- is not assignable. + -- overloaded with the corresponding dereference. Discard the + -- interpretation that yields a reference type, which is not + -- assignable. if Nkind (Lhs) = N_Indexed_Component and then Present (Generalized_Indexing (Lhs)) diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 5110f16b4de..3f7e97b1ef1 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -3761,9 +3761,6 @@ package body Sem_Eval is Source_Type : constant Entity_Id := Etype (Operand); Target_Type : constant Entity_Id := Etype (N); - Stat : Boolean; - Fold : Boolean; - function To_Be_Treated_As_Integer (T : Entity_Id) return Boolean; -- Returns true if type T is an integer type, or if it is a fixed-point -- type to be treated as an integer (i.e. the flag Conversion_OK is set @@ -3796,6 +3793,11 @@ package body Sem_Eval is or else (Is_Fixed_Point_Type (T) and then not Conversion_OK (N)); end To_Be_Treated_As_Real; + -- Local variables + + Fold : Boolean; + Stat : Boolean; + -- Start of processing for Eval_Type_Conversion begin diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3125b372d1f..01d6737551c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5345,7 +5345,6 @@ package body Sem_Util is ------------------------- function Denotes_Same_Prefix (A1, A2 : Node_Id) return Boolean is - begin if Is_Entity_Name (A1) then if Nkind_In (A2, N_Selected_Component, N_Indexed_Component) @@ -7856,6 +7855,7 @@ package body Sem_Util is return Defining_Entity (Unit); end if; end Get_Parent_Entity; + ------------------- -- Get_Pragma_Id -- ------------------- @@ -8806,7 +8806,7 @@ package body Sem_Util is Comp : Entity_Id; begin - -- A scalar type is fully default initialized if it is subjec to aspect + -- A scalar type is fully default initialized if it is subject to aspect -- Default_Value. if Is_Scalar_Type (Typ) then -- 2.30.2