diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_ch13.adb | 92 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 105 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 292 | ||||
| -rw-r--r-- | gcc/ada/exp_strm.adb | 53 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 40 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 130 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 30 |
13 files changed, 411 insertions, 463 deletions
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index d2be185..444f752 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -631,58 +631,56 @@ package body Exp_Ch13 is -- assignments, and wrappers may need checks. Other freezing actions -- should be compiled with all checks off. - if Present (Actions (N)) then - Decl := First (Actions (N)); - while Present (Decl) loop - if Nkind (Decl) = N_Subprogram_Body - and then (Is_Init_Proc (Defining_Entity (Decl)) - or else - Chars (Defining_Entity (Decl)) = Name_uAssign - or else - (Present (Corresponding_Spec (Decl)) - and then Is_Wrapper - (Corresponding_Spec (Decl)))) - then - Analyze (Decl); + Decl := First (Actions (N)); + while Present (Decl) loop + if Nkind (Decl) = N_Subprogram_Body + and then (Is_Init_Proc (Defining_Entity (Decl)) + or else + Chars (Defining_Entity (Decl)) = Name_uAssign + or else + (Present (Corresponding_Spec (Decl)) + and then Is_Wrapper + (Corresponding_Spec (Decl)))) + then + Analyze (Decl); - -- A subprogram body created for a renaming_as_body completes - -- a previous declaration, which may be in a different scope. - -- Establish the proper scope before analysis. + -- A subprogram body created for a renaming_as_body completes + -- a previous declaration, which may be in a different scope. + -- Establish the proper scope before analysis. - elsif Nkind (Decl) = N_Subprogram_Body - and then Present (Corresponding_Spec (Decl)) - and then Scope (Corresponding_Spec (Decl)) /= Current_Scope - then - Push_Scope (Scope (Corresponding_Spec (Decl))); - Analyze (Decl, Suppress => All_Checks); - Pop_Scope; - - -- We treat generated equality specially, if validity checks are - -- enabled, in order to detect components default-initialized - -- with invalid values. - - elsif Nkind (Decl) = N_Subprogram_Body - and then Chars (Defining_Entity (Decl)) = Name_Op_Eq - and then Validity_Checks_On - and then Initialize_Scalars - then - declare - Save_Force : constant Boolean := Force_Validity_Checks; - begin - Force_Validity_Checks := True; - Analyze (Decl); - Force_Validity_Checks := Save_Force; - end; + elsif Nkind (Decl) = N_Subprogram_Body + and then Present (Corresponding_Spec (Decl)) + and then Scope (Corresponding_Spec (Decl)) /= Current_Scope + then + Push_Scope (Scope (Corresponding_Spec (Decl))); + Analyze (Decl, Suppress => All_Checks); + Pop_Scope; + + -- We treat generated equality specially, if validity checks are + -- enabled, in order to detect components default-initialized with + -- invalid values. + + elsif Nkind (Decl) = N_Subprogram_Body + and then Chars (Defining_Entity (Decl)) = Name_Op_Eq + and then Validity_Checks_On + and then Initialize_Scalars + then + declare + Save_Force : constant Boolean := Force_Validity_Checks; + begin + Force_Validity_Checks := True; + Analyze (Decl); + Force_Validity_Checks := Save_Force; + end; - -- All other freezing actions + -- All other freezing actions - else - Analyze (Decl, Suppress => All_Checks); - end if; + else + Analyze (Decl, Suppress => All_Checks); + end if; - Next (Decl); - end loop; - end if; + Next (Decl); + end loop; -- If we are to delete this N_Freeze_Entity, do so by rewriting so that -- a loop on all nodes being inserted will work propertly. diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index b995577..2072935 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -4530,75 +4530,72 @@ package body Exp_Ch5 is -- Loop through elsif parts, dealing with constant conditions and -- possible condition actions that are present. - if Present (Elsif_Parts (N)) then - E := First (Elsif_Parts (N)); - while Present (E) loop + E := First (Elsif_Parts (N)); + while Present (E) loop - -- Do not consider controlled objects found in an if statement - -- which actually models an if expression because their early - -- finalization will affect the result of the expression. + -- Do not consider controlled objects found in an if statement which + -- actually models an if expression because their early finalization + -- will affect the result of the expression. - if not From_Conditional_Expression (N) then - Process_Statements_For_Controlled_Objects (E); - end if; + if not From_Conditional_Expression (N) then + Process_Statements_For_Controlled_Objects (E); + end if; - Adjust_Condition (Condition (E)); + Adjust_Condition (Condition (E)); - -- If there are condition actions, then rewrite the if statement - -- as indicated above. We also do the same rewrite for a True or - -- False condition. The further processing of this constant - -- condition is then done by the recursive call to expand the - -- newly created if statement + -- If there are condition actions, then rewrite the if statement as + -- indicated above. We also do the same rewrite for a True or False + -- condition. The further processing of this constant condition is + -- then done by the recursive call to expand the newly created if + -- statement - if Present (Condition_Actions (E)) - or else Compile_Time_Known_Value (Condition (E)) - then - New_If := - Make_If_Statement (Sloc (E), - Condition => Condition (E), - Then_Statements => Then_Statements (E), - Elsif_Parts => No_List, - Else_Statements => Else_Statements (N)); - - -- Elsif parts for new if come from remaining elsif's of parent - - while Present (Next (E)) loop - if No (Elsif_Parts (New_If)) then - Set_Elsif_Parts (New_If, New_List); - end if; + if Present (Condition_Actions (E)) + or else Compile_Time_Known_Value (Condition (E)) + then + New_If := + Make_If_Statement (Sloc (E), + Condition => Condition (E), + Then_Statements => Then_Statements (E), + Elsif_Parts => No_List, + Else_Statements => Else_Statements (N)); + + -- Elsif parts for new if come from remaining elsif's of parent + + while Present (Next (E)) loop + if No (Elsif_Parts (New_If)) then + Set_Elsif_Parts (New_If, New_List); + end if; - Append (Remove_Next (E), Elsif_Parts (New_If)); - end loop; + Append (Remove_Next (E), Elsif_Parts (New_If)); + end loop; - Set_Else_Statements (N, New_List (New_If)); + Set_Else_Statements (N, New_List (New_If)); - Insert_List_Before (New_If, Condition_Actions (E)); + Insert_List_Before (New_If, Condition_Actions (E)); - Remove (E); + Remove (E); - if Is_Empty_List (Elsif_Parts (N)) then - Set_Elsif_Parts (N, No_List); - end if; + if Is_Empty_List (Elsif_Parts (N)) then + Set_Elsif_Parts (N, No_List); + end if; - Analyze (New_If); + Analyze (New_If); - -- Note this is not an implicit if statement, since it is part - -- of an explicit if statement in the source (or of an implicit - -- if statement that has already been tested). We set the flag - -- after calling Analyze to avoid generating extra warnings - -- specific to pure if statements, however (see - -- Sem_Ch5.Analyze_If_Statement). + -- Note this is not an implicit if statement, since it is part of + -- an explicit if statement in the source (or of an implicit if + -- statement that has already been tested). We set the flag after + -- calling Analyze to avoid generating extra warnings specific to + -- pure if statements, however (see Sem_Ch5.Analyze_If_Statement). - Preserve_Comes_From_Source (New_If, N); - return; + Preserve_Comes_From_Source (New_If, N); + return; - -- No special processing for that elsif part, move to next + -- No special processing for that elsif part, move to next - else - Next (E); - end if; - end loop; - end if; + else + Next (E); + end if; + end loop; -- Some more optimizations applicable if we still have an IF statement diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index be791c3..ed6844e 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -9303,171 +9303,167 @@ package body Exp_Ch9 is -- Add private field components - if Present (Private_Declarations (Pdef)) then - Priv := First (Private_Declarations (Pdef)); - while Present (Priv) loop - if Nkind (Priv) = N_Component_Declaration then - if not Static_Component_Size (Defining_Identifier (Priv)) then - - -- When compiling for a restricted profile, the private - -- components must have a static size. If not, this is an - -- error for a single protected declaration, and rates a - -- warning on a protected type declaration. - - if not Comes_From_Source (Prot_Typ) then - - -- It's ok to be checking this restriction at expansion - -- time, because this is only for the restricted profile, - -- which is not subject to strict RM conformance, so it - -- is OK to miss this check in -gnatc mode. - - Check_Restriction (No_Implicit_Heap_Allocations, Priv); - Check_Restriction - (No_Implicit_Protected_Object_Allocations, Priv); - - elsif Restriction_Active (No_Implicit_Heap_Allocations) then - if not Discriminated_Size (Defining_Identifier (Priv)) - then - -- Any object of the type will be non-static + Priv := First (Private_Declarations (Pdef)); + while Present (Priv) loop + if Nkind (Priv) = N_Component_Declaration then + if not Static_Component_Size (Defining_Identifier (Priv)) then - Error_Msg_N ("component has non-static size??", Priv); - Error_Msg_NE - ("\creation of protected object of type& will " - & "violate restriction " - & "No_Implicit_Heap_Allocations??", Priv, Prot_Typ); - else - -- Object will be non-static if discriminants are + -- When compiling for a restricted profile, the private + -- components must have a static size. If not, this is an error + -- for a single protected declaration, and rates a warning on a + -- protected type declaration. - Error_Msg_NE - ("creation of protected object of type& with " - & "non-static discriminants will violate " - & "restriction No_Implicit_Heap_Allocations??", - Priv, Prot_Typ); - end if; + if not Comes_From_Source (Prot_Typ) then + + -- It's ok to be checking this restriction at expansion + -- time, because this is only for the restricted profile, + -- which is not subject to strict RM conformance, so it + -- is OK to miss this check in -gnatc mode. - -- Likewise for No_Implicit_Protected_Object_Allocations + Check_Restriction (No_Implicit_Heap_Allocations, Priv); + Check_Restriction + (No_Implicit_Protected_Object_Allocations, Priv); - elsif Restriction_Active - (No_Implicit_Protected_Object_Allocations) + elsif Restriction_Active (No_Implicit_Heap_Allocations) then + if not Discriminated_Size (Defining_Identifier (Priv)) then - if not Discriminated_Size (Defining_Identifier (Priv)) - then - -- Any object of the type will be non-static - - Error_Msg_N ("component has non-static size??", Priv); - Error_Msg_NE - ("\creation of protected object of type& will " - & "violate restriction " - & "No_Implicit_Protected_Object_Allocations??", - Priv, Prot_Typ); - else - -- Object will be non-static if discriminants are - - Error_Msg_NE - ("creation of protected object of type& with " - & "non-static discriminants will violate " - & "restriction " - & "No_Implicit_Protected_Object_Allocations??", - Priv, Prot_Typ); - end if; + -- Any object of the type will be non-static + + Error_Msg_N ("component has non-static size??", Priv); + Error_Msg_NE + ("\creation of protected object of type& will " + & "violate restriction " + & "No_Implicit_Heap_Allocations??", Priv, Prot_Typ); + else + -- Object will be non-static if discriminants are + + Error_Msg_NE + ("creation of protected object of type& with " + & "non-static discriminants will violate " + & "restriction No_Implicit_Heap_Allocations??", + Priv, Prot_Typ); + end if; + + -- Likewise for No_Implicit_Protected_Object_Allocations + + elsif Restriction_Active + (No_Implicit_Protected_Object_Allocations) + then + if not Discriminated_Size (Defining_Identifier (Priv)) then + -- Any object of the type will be non-static + + Error_Msg_N ("component has non-static size??", Priv); + Error_Msg_NE + ("\creation of protected object of type& will violate " + & "restriction " + & "No_Implicit_Protected_Object_Allocations??", + Priv, Prot_Typ); + else + -- Object will be non-static if discriminants are + + Error_Msg_NE + ("creation of protected object of type& with " + & "non-static discriminants will violate restriction " + & "No_Implicit_Protected_Object_Allocations??", + Priv, Prot_Typ); end if; end if; + end if; - -- The component definition consists of a subtype indication, - -- or (in Ada 2005) an access definition. Make a copy of the - -- proper definition. + -- The component definition consists of a subtype indication, or + -- (in Ada 2005) an access definition. Make a copy of the proper + -- definition. - declare - Old_Comp : constant Node_Id := Component_Definition (Priv); - Oent : constant Entity_Id := Defining_Identifier (Priv); - Nent : constant Entity_Id := - Make_Defining_Identifier (Sloc (Oent), - Chars => Chars (Oent)); - New_Comp : Node_Id; + declare + Old_Comp : constant Node_Id := Component_Definition (Priv); + Oent : constant Entity_Id := Defining_Identifier (Priv); + Nent : constant Entity_Id := + Make_Defining_Identifier (Sloc (Oent), + Chars => Chars (Oent)); + New_Comp : Node_Id; - begin - if Present (Subtype_Indication (Old_Comp)) then - New_Comp := - Make_Component_Definition (Sloc (Oent), - Aliased_Present => False, - Subtype_Indication => - New_Copy_Tree - (Subtype_Indication (Old_Comp), Discr_Map)); - else - New_Comp := - Make_Component_Definition (Sloc (Oent), - Aliased_Present => False, - Access_Definition => - New_Copy_Tree - (Access_Definition (Old_Comp), Discr_Map)); - - -- A self-reference in the private part becomes a - -- self-reference to the corresponding record. - - if Entity (Subtype_Mark (Access_Definition (New_Comp))) - = Prot_Typ - then - Replace_Access_Definition (New_Comp); - end if; + begin + if Present (Subtype_Indication (Old_Comp)) then + New_Comp := + Make_Component_Definition (Sloc (Oent), + Aliased_Present => False, + Subtype_Indication => + New_Copy_Tree + (Subtype_Indication (Old_Comp), Discr_Map)); + else + New_Comp := + Make_Component_Definition (Sloc (Oent), + Aliased_Present => False, + Access_Definition => + New_Copy_Tree + (Access_Definition (Old_Comp), Discr_Map)); + + -- A self-reference in the private part becomes a + -- self-reference to the corresponding record. + + if Entity (Subtype_Mark (Access_Definition (New_Comp))) + = Prot_Typ + then + Replace_Access_Definition (New_Comp); end if; + end if; - New_Priv := - Make_Component_Declaration (Loc, - Defining_Identifier => Nent, - Component_Definition => New_Comp, - Expression => Expression (Priv)); + New_Priv := + Make_Component_Declaration (Loc, + Defining_Identifier => Nent, + Component_Definition => New_Comp, + Expression => Expression (Priv)); - Set_Has_Per_Object_Constraint (Nent, - Has_Per_Object_Constraint (Oent)); + Set_Has_Per_Object_Constraint (Nent, + Has_Per_Object_Constraint (Oent)); - Append_To (Cdecls, New_Priv); - end; + Append_To (Cdecls, New_Priv); + end; - elsif Nkind (Priv) = N_Subprogram_Declaration then + elsif Nkind (Priv) = N_Subprogram_Declaration then - -- Make the unprotected version of the subprogram available - -- for expansion of intra object calls. There is need for - -- a protected version only if the subprogram is an interrupt - -- handler, otherwise this operation can only be called from - -- within the body. + -- Make the unprotected version of the subprogram available for + -- expansion of intra object calls. There is need for a protected + -- version only if the subprogram is an interrupt handler, + -- otherwise this operation can only be called from within the + -- body. - Sub := - Make_Subprogram_Declaration (Loc, - Specification => - Build_Protected_Sub_Specification - (Priv, Prot_Typ, Unprotected_Mode)); + Sub := + Make_Subprogram_Declaration (Loc, + Specification => + Build_Protected_Sub_Specification + (Priv, Prot_Typ, Unprotected_Mode)); - Insert_After (Current_Node, Sub); - Analyze (Sub); + Insert_After (Current_Node, Sub); + Analyze (Sub); - Set_Protected_Body_Subprogram - (Defining_Unit_Name (Specification (Priv)), - Defining_Unit_Name (Specification (Sub))); - Check_Inlining (Defining_Unit_Name (Specification (Priv))); - Current_Node := Sub; + Set_Protected_Body_Subprogram + (Defining_Unit_Name (Specification (Priv)), + Defining_Unit_Name (Specification (Sub))); + Check_Inlining (Defining_Unit_Name (Specification (Priv))); + Current_Node := Sub; - Sub := - Make_Subprogram_Declaration (Loc, - Specification => - Build_Protected_Sub_Specification - (Priv, Prot_Typ, Protected_Mode)); + Sub := + Make_Subprogram_Declaration (Loc, + Specification => + Build_Protected_Sub_Specification + (Priv, Prot_Typ, Protected_Mode)); - Insert_After (Current_Node, Sub); - Analyze (Sub); - Current_Node := Sub; + Insert_After (Current_Node, Sub); + Analyze (Sub); + Current_Node := Sub; - if Is_Interrupt_Handler - (Defining_Unit_Name (Specification (Priv))) - then - if not Restricted_Profile then - Register_Handler; - end if; + if Is_Interrupt_Handler + (Defining_Unit_Name (Specification (Priv))) + then + if not Restricted_Profile then + Register_Handler; end if; end if; + end if; - Next (Priv); - end loop; - end if; + Next (Priv); + end loop; -- Except for the lock-free implementation, append the _Object field -- with the right type to the component list. We need to compute the @@ -9708,16 +9704,14 @@ package body Exp_Ch9 is -- If there are some private entry declarations, expand it as if they -- were visible entries. - if Present (Private_Declarations (Pdef)) then - Comp := First (Private_Declarations (Pdef)); - while Present (Comp) loop - if Nkind (Comp) = N_Entry_Declaration then - Expand_Entry_Declaration (Comp); - end if; + Comp := First (Private_Declarations (Pdef)); + while Present (Comp) loop + if Nkind (Comp) = N_Entry_Declaration then + Expand_Entry_Declaration (Comp); + end if; - Next (Comp); - end loop; - end if; + Next (Comp); + end loop; -- Create the declaration of an array object which contains the values -- of aspect/pragma Max_Queue_Length for all entries of the protected diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 6eaef4e..d7a73f5 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -1548,37 +1548,32 @@ package body Exp_Strm is function Make_Field_Attributes (Clist : List_Id) return List_Id is Item : Node_Id; - Result : List_Id; + Result : constant List_Id := New_List; begin - Result := New_List; - - if Present (Clist) then - Item := First (Clist); - - -- Loop through components, skipping all internal components, - -- which are not part of the value (e.g. _Tag), except that we - -- don't skip the _Parent, since we do want to process that - -- recursively. If _Parent is an interface type, being abstract - -- with no components there is no need to handle it. - - while Present (Item) loop - if Nkind (Item) = N_Component_Declaration - and then - ((Chars (Defining_Identifier (Item)) = Name_uParent - and then not Is_Interface - (Etype (Defining_Identifier (Item)))) - or else - not Is_Internal_Name (Chars (Defining_Identifier (Item)))) - then - Append_To - (Result, - Make_Field_Attribute (Defining_Identifier (Item))); - end if; - - Next (Item); - end loop; - end if; + -- Loop through components, skipping all internal components, which + -- are not part of the value (e.g. _Tag), except that we don't skip + -- the _Parent, since we do want to process that recursively. If + -- _Parent is an interface type, being abstract with no components + -- there is no need to handle it. + + Item := First (Clist); + while Present (Item) loop + if Nkind (Item) = N_Component_Declaration + and then + ((Chars (Defining_Identifier (Item)) = Name_uParent + and then not Is_Interface + (Etype (Defining_Identifier (Item)))) + or else + not Is_Internal_Name (Chars (Defining_Identifier (Item)))) + then + Append_To + (Result, + Make_Field_Attribute (Defining_Identifier (Item))); + end if; + + Next (Item); + end loop; return Result; end Make_Field_Attributes; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 80a729f..5976b4d 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -946,16 +946,14 @@ package body Sem_Ch10 is -- Treat compilation unit pragmas that appear after the library unit - if Present (Pragmas_After (Aux_Decls_Node (N))) then - declare - Prag_Node : Node_Id := First (Pragmas_After (Aux_Decls_Node (N))); - begin - while Present (Prag_Node) loop - Analyze (Prag_Node); - Next (Prag_Node); - end loop; - end; - end if; + declare + Prag_Node : Node_Id := First (Pragmas_After (Aux_Decls_Node (N))); + begin + while Present (Prag_Node) loop + Analyze (Prag_Node); + Next (Prag_Node); + end loop; + end; -- Analyze the contract of a [generic] subprogram that acts as a -- compilation unit after all compilation pragmas have been analyzed. @@ -3353,19 +3351,17 @@ package body Sem_Ch10 is -- Start of processing for Has_With_Clause begin - if Present (Context_Items (C_Unit)) then - Item := First (Context_Items (C_Unit)); - while Present (Item) loop - if Nkind (Item) = N_With_Clause - and then Limited_Present (Item) = Is_Limited - and then Named_Unit (Item) = Pack - then - return True; - end if; + Item := First (Context_Items (C_Unit)); + while Present (Item) loop + if Nkind (Item) = N_With_Clause + and then Limited_Present (Item) = Is_Limited + and then Named_Unit (Item) = Pack + then + return True; + end if; - Next (Item); - end loop; - end if; + Next (Item); + end loop; return False; end Has_With_Clause; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 57ff450..0b8911b 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11755,13 +11755,11 @@ package body Sem_Ch13 is Nod1 : Node_Id; begin - if Present (Lst) then - Nod1 := First (Lst); - while Present (Nod1) loop - Check_Expr_Constants (Nod1); - Next (Nod1); - end loop; - end if; + Nod1 := First (Lst); + while Present (Nod1) loop + Check_Expr_Constants (Nod1); + Next (Nod1); + end loop; end Check_List_Constants; -- Start of processing for Check_Constant_Address_Clause diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 6c11f64..c5c8a7c 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2019,13 +2019,11 @@ package body Sem_Ch5 is -- Now to analyze the elsif parts if any are present - if Present (Elsif_Parts (N)) then - E := First (Elsif_Parts (N)); - while Present (E) loop - Analyze_Cond_Then (E); - Next (E); - end loop; - end if; + E := First (Elsif_Parts (N)); + while Present (E) loop + Analyze_Cond_Then (E); + Next (E); + end loop; if Present (Else_Statements (N)) then Analyze_Statements (Else_Statements (N)); @@ -2054,13 +2052,11 @@ package body Sem_Ch5 is if Is_True (Expr_Value (Condition (N))) then Remove_Warning_Messages (Else_Statements (N)); - if Present (Elsif_Parts (N)) then - E := First (Elsif_Parts (N)); - while Present (E) loop - Remove_Warning_Messages (Then_Statements (E)); - Next (E); - end loop; - end if; + E := First (Elsif_Parts (N)); + while Present (E) loop + Remove_Warning_Messages (Then_Statements (E)); + Next (E); + end loop; else Remove_Warning_Messages (Then_Statements (N)); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 9950d9e..8fd88ad 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -712,14 +712,12 @@ package body Sem_Ch6 is -- Otherwise analyze the parameters - if Present (Actuals) then - Actual := First (Actuals); - while Present (Actual) loop - Analyze (Actual); - Check_Parameterless_Call (Actual); - Next (Actual); - end loop; - end if; + Actual := First (Actuals); + while Present (Actual) loop + Analyze (Actual); + Check_Parameterless_Call (Actual); + Next (Actual); + end loop; Analyze_Call (N); end Analyze_Function_Call; @@ -2300,15 +2298,13 @@ package body Sem_Ch6 is -- Otherwise analyze the parameters - if Present (Actuals) then - Actual := First (Actuals); + Actual := First (Actuals); - while Present (Actual) loop - Analyze (Actual); - Check_Parameterless_Call (Actual); - Next (Actual); - end loop; - end if; + while Present (Actual) loop + Analyze (Actual); + Check_Parameterless_Call (Actual); + Next (Actual); + end loop; -- Special processing for Elab_Spec, Elab_Body and Elab_Subp_Body calls @@ -3061,31 +3057,27 @@ package body Sem_Ch6 is begin -- Check for aspects that may generate a contract - if Present (Aspect_Specifications (N)) then - Item := First (Aspect_Specifications (N)); - while Present (Item) loop - if Is_Subprogram_Contract_Annotation (Item) then - return True; - end if; + Item := First (Aspect_Specifications (N)); + while Present (Item) loop + if Is_Subprogram_Contract_Annotation (Item) then + return True; + end if; - Next (Item); - end loop; - end if; + Next (Item); + end loop; -- Check for pragmas that may generate a contract - if Present (Decls) then - Item := First (Decls); - while Present (Item) loop - if Nkind (Item) = N_Pragma - and then Is_Subprogram_Contract_Annotation (Item) - then - return True; - end if; + Item := First (Decls); + while Present (Item) loop + if Nkind (Item) = N_Pragma + and then Is_Subprogram_Contract_Annotation (Item) + then + return True; + end if; - Next (Item); - end loop; - end if; + Next (Item); + end loop; return False; end Body_Has_Contract; @@ -3101,41 +3093,37 @@ package body Sem_Ch6 is begin -- Check for SPARK_Mode aspect - if Present (Aspect_Specifications (N)) then - Item := First (Aspect_Specifications (N)); - while Present (Item) loop - if Get_Aspect_Id (Item) = Aspect_SPARK_Mode then - return Get_SPARK_Mode_From_Annotation (Item) = On; - end if; + Item := First (Aspect_Specifications (N)); + while Present (Item) loop + if Get_Aspect_Id (Item) = Aspect_SPARK_Mode then + return Get_SPARK_Mode_From_Annotation (Item) = On; + end if; - Next (Item); - end loop; - end if; + Next (Item); + end loop; -- Check for SPARK_Mode pragma - if Present (Decls) then - Item := First (Decls); - while Present (Item) loop + Item := First (Decls); + while Present (Item) loop - -- Pragmas that apply to a subprogram body are usually grouped - -- together. Look for a potential pragma SPARK_Mode among them. + -- Pragmas that apply to a subprogram body are usually grouped + -- together. Look for a potential pragma SPARK_Mode among them. - if Nkind (Item) = N_Pragma then - if Get_Pragma_Id (Item) = Pragma_SPARK_Mode then - return Get_SPARK_Mode_From_Annotation (Item) = On; - end if; + if Nkind (Item) = N_Pragma then + if Get_Pragma_Id (Item) = Pragma_SPARK_Mode then + return Get_SPARK_Mode_From_Annotation (Item) = On; + end if; - -- Otherwise the first non-pragma declarative item terminates - -- the region where pragma SPARK_Mode may appear. + -- Otherwise the first non-pragma declarative item terminates the + -- region where pragma SPARK_Mode may appear. - else - exit; - end if; + else + exit; + end if; - Next (Item); - end loop; - end if; + Next (Item); + end loop; -- Otherwise, the applicable SPARK_Mode is inherited from the -- enclosing subprogram or package. @@ -7792,17 +7780,15 @@ package body Sem_Ch6 is Check_Statement_Sequence (Then_Statements (Last_Stm)); Check_Statement_Sequence (Else_Statements (Last_Stm)); - if Present (Elsif_Parts (Last_Stm)) then - declare - Elsif_Part : Node_Id := First (Elsif_Parts (Last_Stm)); + declare + Elsif_Part : Node_Id := First (Elsif_Parts (Last_Stm)); - begin - while Present (Elsif_Part) loop - Check_Statement_Sequence (Then_Statements (Elsif_Part)); - Next (Elsif_Part); - end loop; - end; - end if; + begin + while Present (Elsif_Part) loop + Check_Statement_Sequence (Then_Statements (Elsif_Part)); + Next (Elsif_Part); + end loop; + end; return; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 80950b8..0e75bb4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -9831,22 +9831,20 @@ package body Sem_Ch8 is Decl : Node_Id; begin - if Present (L) then - Decl := First (L); - while Present (Decl) loop - if Nkind (Decl) = N_Use_Package_Clause then - Chain_Use_Clause (Decl); - Use_One_Package (Decl, Name (Decl)); + Decl := First (L); + while Present (Decl) loop + if Nkind (Decl) = N_Use_Package_Clause then + Chain_Use_Clause (Decl); + Use_One_Package (Decl, Name (Decl)); - elsif Nkind (Decl) = N_Use_Type_Clause then - Chain_Use_Clause (Decl); - Use_One_Type (Subtype_Mark (Decl)); + elsif Nkind (Decl) = N_Use_Type_Clause then + Chain_Use_Clause (Decl); + Use_One_Type (Subtype_Mark (Decl)); - end if; + end if; - Next (Decl); - end loop; - end if; + Next (Decl); + end loop; end Set_Use; ----------------------------- diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 0d5befc..077c988 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -18910,18 +18910,16 @@ package body Sem_Elab is procedure Collect_Tasks (Decls : List_Id) is begin - if Present (Decls) then - Decl := First (Decls); - while Present (Decl) loop - if Nkind (Decl) = N_Object_Declaration - and then Has_Task (Etype (Defining_Identifier (Decl))) - then - Add_Task_Proc (Etype (Defining_Identifier (Decl))); - end if; + Decl := First (Decls); + while Present (Decl) loop + if Nkind (Decl) = N_Object_Declaration + and then Has_Task (Etype (Defining_Identifier (Decl))) + then + Add_Task_Proc (Etype (Defining_Identifier (Decl))); + end if; - Next (Decl); - end loop; - end if; + Next (Decl); + end loop; end Collect_Tasks; ---------------- diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 553c7e1..114c904 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -7485,17 +7485,15 @@ package body Sem_Eval is return; end if; - if Present (Expressions (N)) then - Exp := First (Expressions (N)); - while Present (Exp) loop - if Raises_Constraint_Error (Exp) then - Why_Not_Static (Exp); - return; - end if; + Exp := First (Expressions (N)); + while Present (Exp) loop + if Raises_Constraint_Error (Exp) then + Why_Not_Static (Exp); + return; + end if; - Next (Exp); - end loop; - end if; + Next (Exp); + end loop; -- Special case a subtype name diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 487cd59..4d67841 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3292,27 +3292,25 @@ package body Sem_Prag is -- Collect all objects that appear in the visible declarations of the -- related package. - if Present (Visible_Declarations (Pack_Spec)) then - Decl := First (Visible_Declarations (Pack_Spec)); - while Present (Decl) loop - if Comes_From_Source (Decl) - and then Nkind (Decl) in N_Object_Declaration - | N_Object_Renaming_Declaration - then - Append_New_Elmt (Defining_Entity (Decl), States_And_Objs); + Decl := First (Visible_Declarations (Pack_Spec)); + while Present (Decl) loop + if Comes_From_Source (Decl) + and then Nkind (Decl) in N_Object_Declaration + | N_Object_Renaming_Declaration + then + Append_New_Elmt (Defining_Entity (Decl), States_And_Objs); - elsif Nkind (Decl) = N_Package_Declaration then - Collect_States_And_Objects (Decl); + elsif Nkind (Decl) = N_Package_Declaration then + Collect_States_And_Objects (Decl); - elsif Is_Single_Concurrent_Type_Declaration (Decl) then - Append_New_Elmt - (Anonymous_Object (Defining_Entity (Decl)), - States_And_Objs); - end if; + elsif Is_Single_Concurrent_Type_Declaration (Decl) then + Append_New_Elmt + (Anonymous_Object (Defining_Entity (Decl)), + States_And_Objs); + end if; - Next (Decl); - end loop; - end if; + Next (Decl); + end loop; end Collect_States_And_Objects; -- Local variables diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index e1cfa04..9f861a2 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7129,16 +7129,14 @@ package body Sem_Util is -- Create new entities for the formal parameters - if Present (Parameter_Specifications (Result)) then - Formal_Spec := First (Parameter_Specifications (Result)); - while Present (Formal_Spec) loop - Def_Id := Defining_Identifier (Formal_Spec); - Set_Defining_Identifier (Formal_Spec, - Make_Defining_Identifier (Sloc (Def_Id), Chars (Def_Id))); - - Next (Formal_Spec); - end loop; - end if; + Formal_Spec := First (Parameter_Specifications (Result)); + while Present (Formal_Spec) loop + Def_Id := Defining_Identifier (Formal_Spec); + Set_Defining_Identifier (Formal_Spec, + Make_Defining_Identifier (Sloc (Def_Id), Chars (Def_Id))); + + Next (Formal_Spec); + end loop; return Result; end Copy_Subprogram_Spec; @@ -19095,13 +19093,11 @@ package body Sem_Util is Nod : Node_Id; begin - if Present (List) then - Nod := First (List); - while Present (Nod) loop - Visit (Nod); - Next (Nod); - end loop; - end if; + Nod := First (List); + while Present (Nod) loop + Visit (Nod); + Next (Nod); + end loop; end Visit_List; ------------------ |