From 400ad4e950bcd8f0940990ea558b1227d8930285 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Mon, 16 Jul 2018 14:12:28 +0000 Subject: [PATCH] [Ada] Minor reformatting 2018-07-16 Hristian Kirtchev gcc/ada/ * einfo.adb, exp_ch7.adb, exp_ch9.adb, exp_unst.adb, inline.adb, sem.adb, sem_ch12.adb, sem_ch13.adb, sem_ch3.adb, sem_eval.adb, sem_util.adb: Minor reformatting. From-SVN: r262730 --- gcc/ada/ChangeLog | 6 ++++ gcc/ada/einfo.adb | 2 +- gcc/ada/exp_ch7.adb | 4 +-- gcc/ada/exp_ch9.adb | 38 +++++++++++----------- gcc/ada/exp_unst.adb | 76 ++++++++++++++++++++++++-------------------- gcc/ada/inline.adb | 17 +++++----- gcc/ada/sem.adb | 1 + gcc/ada/sem_ch12.adb | 17 ++++++---- gcc/ada/sem_ch13.adb | 10 ++---- gcc/ada/sem_ch3.adb | 4 +-- gcc/ada/sem_eval.adb | 37 ++++++++++----------- gcc/ada/sem_util.adb | 32 +++++++++++-------- 12 files changed, 132 insertions(+), 112 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2f860ac4e40..69090661421 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-07-16 Hristian Kirtchev + + * einfo.adb, exp_ch7.adb, exp_ch9.adb, exp_unst.adb, inline.adb, + sem.adb, sem_ch12.adb, sem_ch13.adb, sem_ch3.adb, sem_eval.adb, + sem_util.adb: Minor reformatting. + 2018-07-16 Arnaud Charlet * frontend.adb: Only unnest subprograms if no previous errors were diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index f7742ecfddc..10a04a36015 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -5972,7 +5972,7 @@ package body Einfo is procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is begin pragma Assert - (Ekind_In (Id, E_Constant, E_Variable, E_Loop_Parameter) + (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable) or else Is_Formal (Id) or else Is_Type (Id)); Set_Flag283 (Id, V); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index b1f2b436ec8..2f3092d98b1 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3984,9 +3984,9 @@ package body Exp_Ch7 is end if; end Cleanup_Task; - ----------------------------------- + -------------------------------------- -- Check_Unnesting_Elaboration_Code -- - ----------------------------------- + -------------------------------------- procedure Check_Unnesting_Elaboration_Code (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 7d1ba352670..6266c613920 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -475,9 +475,9 @@ package body Exp_Ch9 is -- := P.; procedure Reset_Scopes_To (Proc_Body : Node_Id; E : Entity_Id); - -- Reset the scope of declarations and blocks at the top level of - -- Proc_Body to be E. Used after expanding entry bodies into their - -- corresponding procedures. + -- Reset the scope of declarations and blocks at the top level of Proc_Body + -- to be E. Used after expanding entry bodies into their corresponding + -- procedures. function Trivial_Accept_OK return Boolean; -- If there is no DO-END block for an accept, or if the DO-END block has @@ -10557,13 +10557,14 @@ package body Exp_Ch9 is Eloc : constant Source_Ptr := Sloc (Ename); Eent : constant Entity_Id := Entity (Ename); Index : constant Node_Id := Entry_Index (Acc_Stm); + + Call : Node_Id; + Expr : Node_Id; Null_Body : Node_Id; - Proc_Body : Node_Id; PB_Ent : Entity_Id; - Expr : Node_Id; - Call : Node_Id; + Proc_Body : Node_Id; - -- Start of processing for Add_Accept + -- Start of processing for Add_Accept begin if No (Ann) then @@ -10577,9 +10578,7 @@ package body Exp_Ch9 is Entry_Index_Expression (Eloc, Eent, Index, Scope (Eent)), New_Occurrence_Of (RTE (RE_Null_Task_Entry), Eloc))); else - Expr := - Entry_Index_Expression - (Eloc, Eent, Index, Scope (Eent)); + Expr := Entry_Index_Expression (Eloc, Eent, Index, Scope (Eent)); end if; if Present (Handled_Statement_Sequence (Accept_Statement (Alt))) then @@ -10603,7 +10602,7 @@ package body Exp_Ch9 is Make_Defining_Identifier (Eloc, New_External_Name (Chars (Ename), 'A', Num_Accept)); - -- Link the acceptor to the original receiving entry. + -- Link the acceptor to the original receiving entry Set_Ekind (PB_Ent, E_Procedure); Set_Receiving_Entry (PB_Ent, Eent); @@ -14731,12 +14730,10 @@ package body Exp_Ch9 is --------------------- procedure Reset_Scopes_To (Proc_Body : Node_Id; E : Entity_Id) is - function Reset_Scope (N : Node_Id) return Traverse_Result; - -- Temporaries may have been declared during expansion of the - -- procedure alternative. Indicate that their scope is the new - -- body, to prevent generation of spurious uplevel references - -- for these entities. + -- Temporaries may have been declared during expansion of the procedure + -- alternative. Indicate that their scope is the new body, to prevent + -- generation of spurious uplevel references for these entities. procedure Reset_Scopes is new Traverse_Proc (Reset_Scope); @@ -14748,10 +14745,11 @@ package body Exp_Ch9 is Decl : Node_Id; begin - -- If this is a block statement with an Identifier, it forms - -- a scope, so we want to reset its scope but not look inside. + -- If this is a block statement with an Identifier, it forms a scope, + -- so we want to reset its scope but not look inside. - if Nkind (N) = N_Block_Statement and then Present (Identifier (N)) + if Nkind (N) = N_Block_Statement + and then Present (Identifier (N)) then Set_Scope (Entity (Identifier (N)), E); return Skip; @@ -14779,6 +14777,8 @@ package body Exp_Ch9 is return OK; end Reset_Scope; + -- Start of processing for Reset_Scopes_To + begin Reset_Scopes (Proc_Body); end Reset_Scopes_To; diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index ef5ab4a366d..12cb9bd656e 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -526,8 +526,8 @@ package body Exp_Unst is end loop; end; - -- Binary operator cases. These can apply - -- to arrays for which we may need bounds. + -- Binary operator cases. These can apply to arrays for + -- which we may need bounds. elsif Nkind (N) in N_Binary_Op then Note_Uplevel_Bound (Left_Opnd (N), Ref); @@ -944,7 +944,9 @@ package body Exp_Unst is -- and if the lower bound (or an inner bound for a multi- -- dimensional array) is uplevel. - when N_Indexed_Component | N_Slice => + when N_Indexed_Component + | N_Slice + => if Is_Constrained (Etype (Prefix (N))) then declare DT : Boolean := False; @@ -975,7 +977,9 @@ package body Exp_Unst is -- in order to do the comparison, which means we need the -- bounds. - when N_Op_Eq | N_Op_Ne => + when N_Op_Eq + | N_Op_Ne + => declare DT : Boolean := False; begin @@ -1075,13 +1079,14 @@ package body Exp_Unst is return Skip; end if; - -- Pragmas and component declarations can be ignored. + -- Pragmas and component declarations can be ignored - when N_Pragma | N_Component_Declaration => + when N_Component_Declaration + | N_Pragma + => return Skip; - -- Otherwise record an uplevel reference in a local - -- identifier. + -- Otherwise record an uplevel reference in a local identifier when others => if Nkind (N) in N_Has_Entity @@ -1103,23 +1108,25 @@ package body Exp_Unst is -- references to global declarations. and then - (Ekind_In - (Ent, E_Constant, E_Variable, E_Loop_Parameter) + (Ekind_In (Ent, E_Constant, + E_Loop_Parameter, + E_Variable) - -- Formals are interesting, but not if being used as - -- mere names of parameters for name notation calls. + -- Formals are interesting, but not if being used + -- as mere names of parameters for name notation + -- calls. - or else - (Is_Formal (Ent) - and then not - (Nkind (Parent (N)) = N_Parameter_Association - and then Selector_Name (Parent (N)) = N)) + or else + (Is_Formal (Ent) + and then not + (Nkind (Parent (N)) = N_Parameter_Association + and then Selector_Name (Parent (N)) = N)) - -- Types other than known Is_Static types are - -- potentially interesting. + -- Types other than known Is_Static types are + -- potentially interesting. - or else (Is_Type (Ent) - and then not Is_Static_Type (Ent))) + or else + (Is_Type (Ent) and then not Is_Static_Type (Ent))) then -- Here we have a potentially interesting uplevel -- reference to examine. @@ -1284,10 +1291,10 @@ package body Exp_Unst is loop S := Enclosing_Subprogram (S); - -- if we are at the top level, as can happen with + -- 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. + -- declarations, there are no further subprograms to mark + -- as requiring activation records. exit when No (S); @@ -1298,10 +1305,10 @@ package body Exp_Unst is -- If this entity was marked reachable because it is -- in a task or protected type, there may not appear - -- to be any calls to it, which would normally - -- adjust the levels of the parent subprograms. - -- So we need to be sure that the uplevel reference - -- of that entity takes into account possible calls. + -- to be any calls to it, which would normally adjust + -- the levels of the parent subprograms. So we need to + -- be sure that the uplevel reference of that entity + -- takes into account possible calls. if In_Synchronized_Unit (SUBF.Ent) and then SUBT.Lev < SUBI.Uplevel_Ref @@ -1874,10 +1881,10 @@ package body Exp_Unst is begin -- For parameters, we insert the assignment -- right after the declaration of ARECnP. - -- For all other entities, we insert - -- the assignment immediately after the - -- declaration of the entity or after - -- the freeze node if present. + -- For all other entities, we insert the + -- assignment immediately after the + -- declaration of the entity or after the + -- freeze node if present. -- Note: we don't need to mark the entity -- as being aliased, because the address @@ -1928,8 +1935,9 @@ package body Exp_Unst is -- N_Loop_Parametrer_Specification. if Ekind (Ent) = E_Loop_Parameter then - Ins := First (Statements - (Parent (Parent (Ins)))); + Ins := + First + (Statements (Parent (Parent (Ins)))); Insert_Before (Ins, Asn); else diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index df7fdb9e893..b425094b544 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -3926,12 +3926,12 @@ package body Inline is end if; end if; - -- A return statement within an extended return is a noop - -- after inlining. + -- A return statement within an extended return is a noop after + -- inlining. elsif No (Expression (N)) - and then - Nkind (Parent (Parent (N))) = N_Extended_Return_Statement + and then Nkind (Parent (Parent (N))) = + N_Extended_Return_Statement then return OK; @@ -3970,10 +3970,11 @@ package body Inline is return True; else - return Present (Declarations (N)) - and then Present (First (Declarations (N))) - and then Entity (Expression (Return_Statement)) = - Defining_Identifier (First (Declarations (N))); + return + Present (Declarations (N)) + and then Present (First (Declarations (N))) + and then Entity (Expression (Return_Statement)) = + Defining_Identifier (First (Declarations (N))); end if; end Has_Single_Return; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index b80dfcfdef6..7fbf7bde1c8 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -2180,6 +2180,7 @@ package body Sem is function Is_Subunit_Of_Main (U : Node_Id) return Boolean is Lib : Node_Id; + begin if Present (U) and then Nkind (Unit (U)) = N_Subunit then Lib := Library_Unit (U); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index a7f9fbd2961..98c646d9a6b 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4216,15 +4216,19 @@ package body Sem_Ch12 is else declare - ASN1, ASN2 : Node_Id; Inherited_Aspects : constant List_Id := - New_Copy_List_Tree (Aspect_Specifications (Gen_Spec)); + New_Copy_List_Tree + (Aspect_Specifications (Gen_Spec)); + + ASN1 : Node_Id; + ASN2 : Node_Id; Pool_Present : Boolean := False; begin ASN1 := First (Aspect_Specifications (N)); while Present (ASN1) loop - if Chars (Identifier (ASN1)) = Name_Default_Storage_Pool + if Chars (Identifier (ASN1)) = + Name_Default_Storage_Pool then Pool_Present := True; exit; @@ -4234,13 +4238,14 @@ package body Sem_Ch12 is end loop; if Pool_Present then - -- If generic carries a default storage pool, remove - -- it in favor of the instance one. + + -- If generic carries a default storage pool, remove it + -- in favor of the instance one. ASN2 := First (Inherited_Aspects); while Present (ASN2) loop if Chars (Identifier (ASN2)) = - Name_Default_Storage_Pool + Name_Default_Storage_Pool then Remove (ASN2); exit; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 17b138d38d0..28a3dd8fe61 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -5331,9 +5331,7 @@ package body Sem_Ch13 is Error_Msg_N ("Bit_Order can only be defined for record type", Nam); - elsif Is_Tagged_Type (U_Ent) - and then Is_Derived_Type (U_Ent) - then + elsif Is_Tagged_Type (U_Ent) and then Is_Derived_Type (U_Ent) then Error_Msg_N ("Bit_Order cannot be defined for record extensions", Nam); @@ -5350,10 +5348,8 @@ package body Sem_Ch13 is Flag_Non_Static_Expr ("Bit_Order requires static expression!", Expr); - else - if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then - Set_Reverse_Bit_Order (Base_Type (U_Ent), True); - end if; + elsif (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then + Set_Reverse_Bit_Order (Base_Type (U_Ent), True); end if; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9a9c15003f6..fce4992cff0 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -18621,9 +18621,7 @@ package body Sem_Ch3 is if Is_Itype (Subt) and then Present (Predicate_Function (Par)) then Set_Subprograms_For_Type (Subt, Subprograms_For_Type (Par)); - if Has_Static_Predicate (Par) - and then Is_Discrete_Type (Par) - then + if Has_Static_Predicate (Par) and then Is_Discrete_Type (Par) then Set_Static_Discrete_Predicate (Subt, Static_Discrete_Predicate (Par)); end if; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index ab85879374e..233f24dd48a 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -2688,9 +2688,7 @@ package body Sem_Eval is -- the expander that do not correspond to static expressions. procedure Eval_Integer_Literal (N : Node_Id) is - T : constant Entity_Id := Etype (N); - - function In_Any_Integer_Context return Boolean; + function In_Any_Integer_Context (Context : Node_Id) return Boolean; -- If the literal is resolved with a specific type in a context where -- the expected type is Any_Integer, there are no range checks on the -- literal. By the time the literal is evaluated, it carries the type @@ -2701,22 +2699,25 @@ package body Sem_Eval is -- In_Any_Integer_Context -- ---------------------------- - function In_Any_Integer_Context return Boolean is - Par : constant Node_Id := Parent (N); - K : constant Node_Kind := Nkind (Par); - + function In_Any_Integer_Context (Context : Node_Id) return Boolean is begin -- Any_Integer also appears in digits specifications for real types, -- but those have bounds smaller that those of any integer base type, -- so we can safely ignore these cases. - return Nkind_In (K, N_Number_Declaration, - N_Attribute_Reference, - N_Attribute_Definition_Clause, - N_Modular_Type_Definition, - N_Signed_Integer_Type_Definition); + return + Nkind_In (Context, N_Attribute_Definition_Clause, + N_Attribute_Reference, + N_Modular_Type_Definition, + N_Number_Declaration, + N_Signed_Integer_Type_Definition); end In_Any_Integer_Context; + -- Local variables + + Par : constant Node_Id := Parent (N); + Typ : constant Entity_Id := Etype (N); + -- Start of processing for Eval_Integer_Literal begin @@ -2732,20 +2733,20 @@ package body Sem_Eval is -- Check_Non_Static_Context on an expanded literal may lead to spurious -- and misleading warnings. - if (Nkind_In (Parent (N), N_If_Expression, N_Case_Expression_Alternative) + if (Nkind_In (Par, N_If_Expression, N_Case_Expression_Alternative) or else Nkind (Parent (N)) not in N_Subexpr) - and then (not Nkind_In (Parent (N), N_If_Expression, - N_Case_Expression_Alternative) + and then (not Nkind_In (Par, N_Case_Expression_Alternative, + N_If_Expression) or else Comes_From_Source (N)) - and then not In_Any_Integer_Context + and then not In_Any_Integer_Context (Par) then Check_Non_Static_Context (N); end if; -- Modular integer literals must be in their base range - if Is_Modular_Integer_Type (T) - and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) + if Is_Modular_Integer_Type (Typ) + and then Is_Out_Of_Range (N, Base_Type (Typ), Assume_Valid => True) then Out_Of_Range (N); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b6b939cca4e..1c3610c3251 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5993,9 +5993,6 @@ package body Sem_Util is ------------------------- function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean is - Obj1 : Node_Id := A1; - Obj2 : Node_Id := A2; - function Is_Renaming (N : Node_Id) return Boolean; -- Return true if N names a renaming entity @@ -6011,8 +6008,8 @@ package body Sem_Util is function Is_Renaming (N : Node_Id) return Boolean is begin - return Is_Entity_Name (N) - and then Present (Renamed_Entity (Entity (N))); + return + Is_Entity_Name (N) and then Present (Renamed_Entity (Entity (N))); end Is_Renaming; ----------------------- @@ -6020,10 +6017,13 @@ package body Sem_Util is ----------------------- function Is_Valid_Renaming (N : Node_Id) return Boolean is - function Check_Renaming (N : Node_Id) return Boolean; -- Recursive function used to traverse all the prefixes of N + -------------------- + -- Check_Renaming -- + -------------------- + function Check_Renaming (N : Node_Id) return Boolean is begin if Is_Renaming (N) @@ -6083,6 +6083,11 @@ package body Sem_Util is return Check_Renaming (N); end Is_Valid_Renaming; + -- Local variables + + Obj1 : Node_Id := A1; + Obj2 : Node_Id := A2; + -- Start of processing for Denotes_Same_Object begin @@ -11542,14 +11547,13 @@ package body Sem_Util is function Has_Prefix (N : Node_Id) return Boolean is begin return - Nkind_In (N, - N_Attribute_Reference, - N_Expanded_Name, - N_Explicit_Dereference, - N_Indexed_Component, - N_Reference, - N_Selected_Component, - N_Slice); + Nkind_In (N, N_Attribute_Reference, + N_Expanded_Name, + N_Explicit_Dereference, + N_Indexed_Component, + N_Reference, + N_Selected_Component, + N_Slice); end Has_Prefix; --------------------------- -- 2.30.2