From 92a68a0464fc59667a3713c2a041b9f4582122a4 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 21 Aug 2018 14:50:03 +0000 Subject: [PATCH] [Ada] Minor reformattings 2018-08-21 Hristian Kirtchev gcc/ada/ * checks.adb, contracts.adb, exp_aggr.adb, exp_attr.adb, exp_ch6.adb, exp_ch7.adb, exp_ch9.adb, exp_unst.adb, exp_util.adb, freeze.adb, gnatlink.adb, layout.adb, lib-writ.adb, lib-xref-spark_specific.adb, sem_ch13.adb, sem_ch3.adb, sem_ch6.adb, sem_res.adb, sem_util.adb, sinfo.ads, sprint.adb: Minor reformatting. From-SVN: r263737 --- gcc/ada/ChangeLog | 9 ++++++ gcc/ada/checks.adb | 6 ++-- gcc/ada/contracts.adb | 19 ++++++----- gcc/ada/exp_aggr.adb | 5 ++- gcc/ada/exp_attr.adb | 40 +++++++++++++---------- gcc/ada/exp_ch6.adb | 5 +-- gcc/ada/exp_ch7.adb | 7 +++-- gcc/ada/exp_ch9.adb | 8 ++--- gcc/ada/exp_unst.adb | 13 +++----- gcc/ada/exp_util.adb | 19 +++++------ gcc/ada/freeze.adb | 33 ++++++++++--------- gcc/ada/gnatlink.adb | 6 ++-- gcc/ada/layout.adb | 7 ++--- gcc/ada/lib-writ.adb | 13 +++++--- gcc/ada/lib-xref-spark_specific.adb | 1 + gcc/ada/sem_ch13.adb | 49 +++++++++++++++-------------- gcc/ada/sem_ch3.adb | 8 +++-- gcc/ada/sem_ch6.adb | 14 ++++++--- gcc/ada/sem_res.adb | 17 +++++++--- gcc/ada/sem_util.adb | 5 ++- gcc/ada/sinfo.ads | 2 +- gcc/ada/sprint.adb | 9 ++---- 22 files changed, 163 insertions(+), 132 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8d0da5a6e35..062270177fb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2018-08-21 Hristian Kirtchev + + * checks.adb, contracts.adb, exp_aggr.adb, exp_attr.adb, + exp_ch6.adb, exp_ch7.adb, exp_ch9.adb, exp_unst.adb, + exp_util.adb, freeze.adb, gnatlink.adb, layout.adb, + lib-writ.adb, lib-xref-spark_specific.adb, sem_ch13.adb, + sem_ch3.adb, sem_ch6.adb, sem_res.adb, sem_util.adb, sinfo.ads, + sprint.adb: Minor reformatting. + 2018-08-21 Jerome Lambourg * vxlink-bind.adb, vxlink-bind.ads, vxlink-link.adb, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index f399cda780c..1704a2f81f2 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6780,9 +6780,9 @@ package body Checks is and then Is_Integer_Type (Target_Base_Type) then Conv_Node := - OK_Convert_To ( - Typ => Target_Base_Type, - Expr => Duplicate_Subexpr (N)); + OK_Convert_To + (Typ => Target_Base_Type, + Expr => Duplicate_Subexpr (N)); -- Common case diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index e70765a06e8..26a8d2894b2 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -592,18 +592,20 @@ package body Contracts is null; -- Otherwise analyze the pre/postconditions. Their expressions - -- might include references to types that are not frozen yet, - -- in the case where the body is a rewritten expression function - -- that is a completion, so freeze all types within before - -- constructing the contract code. + -- might include references to types that are not frozen yet, in the + -- case where the body is a rewritten expression function that is a + -- completion, so freeze all types within before constructing the + -- contract code. else declare - Bod : Node_Id; + Bod : Node_Id; Freeze_Types : Boolean := False; + begin if Present (Freeze_Id) then Bod := Unit_Declaration_Node (Freeze_Id); + if Nkind (Bod) = N_Subprogram_Body and then Was_Expression_Function (Bod) and then Ekind (Subp_Id) = E_Function @@ -617,8 +619,11 @@ package body Contracts is Prag := Pre_Post_Conditions (Items); while Present (Prag) loop if Freeze_Types then - Freeze_Expr_Types (Subp_Id, Standard_Boolean, - Expression (Corresponding_Aspect (Prag)), Bod); + Freeze_Expr_Types + (Def_Id => Subp_Id, + Typ => Standard_Boolean, + Expr => Expression (Corresponding_Aspect (Prag)), + N => Bod); end if; Analyze_Pre_Post_Condition_In_Decl_Part (Prag, Freeze_Id); diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index d1d9c12d458..f65230f5a72 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6212,7 +6212,7 @@ package body Exp_Aggr is Establish_Transient_Scope (N, Manage_Sec_Stack => False); end if; - -- An array of limited components is built in place. + -- An array of limited components is built in place if Is_Limited_Type (Typ) then Maybe_In_Place_OK := True; @@ -6258,7 +6258,7 @@ package body Exp_Aggr is -- oversight: the rules in 7.6 (17) are clear. if (not Has_Default_Init_Comps (N) - or else Is_Limited_Type (Etype (N))) + or else Is_Limited_Type (Etype (N))) and then Comes_From_Source (Parent_Node) and then Parent_Kind = N_Object_Declaration and then Present (Expression (Parent_Node)) @@ -6385,7 +6385,6 @@ package body Exp_Aggr is if Has_Default_Init_Comps (N) and then not Maybe_In_Place_OK then - -- Ada 2005 (AI-287): This case has not been analyzed??? raise Program_Error; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 469a90e6ae1..d789748613b 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3672,29 +3672,35 @@ package body Exp_Attr is if Is_Fixed_Point_Type (Etype (N)) then declare Loc : constant Source_Ptr := Sloc (N); - Equiv_T : constant Entity_Id := Make_Temporary (Loc, 'T', N); - Expr : constant Node_Id := Expression (N); - Fst : constant Entity_Id := Root_Type (Etype (N)); + Equiv_T : constant Entity_Id := Make_Temporary (Loc, 'T', N); + Expr : constant Node_Id := Expression (N); + Fst : constant Entity_Id := Root_Type (Etype (N)); Decl : Node_Id; begin - Decl := Make_Full_Type_Declaration (Sloc (N), - Equiv_T, - Type_Definition => - Make_Signed_Integer_Type_Definition (Loc, - Low_Bound => Make_Integer_Literal (Loc, - Intval => Corresponding_Integer_Value - (Type_Low_Bound (Fst))), - High_Bound => Make_Integer_Literal (Loc, - Intval => Corresponding_Integer_Value - (Type_High_Bound (Fst))))); + Decl := + Make_Full_Type_Declaration (Sloc (N), + Defining_Identifier => Equiv_T, + Type_Definition => + Make_Signed_Integer_Type_Definition (Loc, + Low_Bound => + Make_Integer_Literal (Loc, + Intval => + Corresponding_Integer_Value + (Type_Low_Bound (Fst))), + High_Bound => + Make_Integer_Literal (Loc, + Intval => + Corresponding_Integer_Value + (Type_High_Bound (Fst))))); Insert_Action (N, Decl); - -- Verify that the conversion is possible. - Generate_Range_Check - (Expr, Equiv_T, CE_Overflow_Check_Failed); + -- Verify that the conversion is possible + + Generate_Range_Check (Expr, Equiv_T, CE_Overflow_Check_Failed); + + -- and verify that the result is in range - -- and verify that the result is in range. Generate_Range_Check (N, Etype (N), CE_Range_Check_Failed); end; end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 224f4c76722..e08b748fa35 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6402,12 +6402,13 @@ package body Exp_Ch6 is and then Is_Protected_Type (Etype (Prefix (Name (Parent (N))))) and then Is_Entity_Name (Name (N)) and then Scope (Entity (Name (N))) = - Etype (Prefix (Name (Parent (N)))) + Etype (Prefix (Name (Parent (N)))) then Rewrite (Name (N), Make_Selected_Component (Sloc (N), - Prefix => New_Copy_Tree (Prefix (Name (Parent (N)))), + Prefix => New_Copy_Tree (Prefix (Name (Parent (N)))), Selector_Name => Relocate_Node (Name (N)))); + Analyze_And_Resolve (N); return; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 1b8b8f254f1..ee04b22254a 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4030,8 +4030,8 @@ package body Exp_Ch7 is ----------------------- function First_Local_Scope (L : List_Id) return Entity_Id is - Stat : Node_Id; Scop : Entity_Id; + Stat : Node_Id; begin Stat := First (L); @@ -4099,6 +4099,7 @@ package body Exp_Ch7 is when others => null; end case; + Next (Stat); end loop; @@ -4119,8 +4120,8 @@ package body Exp_Ch7 is and then Present (Handled_Statement_Sequence (N)) and then Is_Compilation_Unit (Current_Scope) then - Ent := First_Local_Scope - (Statements (Handled_Statement_Sequence (N))); + Ent := + First_Local_Scope (Statements (Handled_Statement_Sequence (N))); if Present (Ent) then Elab_Proc := diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index c398948ed87..4470c4e9854 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -8241,6 +8241,7 @@ package body Exp_Ch9 is end if; Analyze (N); + Reset_Scopes_To (N, Entity (Identifier (N))); end Expand_N_Conditional_Entry_Call; @@ -10707,7 +10708,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); @@ -14850,7 +14851,6 @@ package body Exp_Ch9 is --------------------- procedure Reset_Scopes_To (Bod : 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 -- created for an entry body or an accept alternative. Indicate that @@ -14880,8 +14880,8 @@ package body Exp_Ch9 is -- Ditto for a package declaration or a full type declaration, etc. elsif Nkind (N) = N_Package_Declaration - or else Nkind (N) in N_Declaration - or else Nkind (N) in N_Renaming_Declaration + or else Nkind (N) in N_Declaration + or else Nkind (N) in N_Renaming_Declaration then Set_Scope (Defining_Entity (N), E); return Skip; diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index c5b03c4100d..d688157e768 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -260,12 +260,10 @@ package body Exp_Unst is E := Ultimate_Alias (E); -- The body of a protected operation has a different name and - -- has been scanned at this point, and thus has an entry in - -- the subprogram table. + -- has been scanned at this point, and thus has an entry in the + -- subprogram table. - if E = Sub - and then Convention (E) = Convention_Protected - then + if E = Sub and then Convention (E) = Convention_Protected then E := Protected_Body_Subprogram (E); end if; @@ -551,9 +549,8 @@ package body Exp_Unst is -- Explicit dereference and selected component case - elsif Nkind_In (N, - N_Explicit_Dereference, - N_Selected_Component) + elsif Nkind_In (N, N_Explicit_Dereference, + N_Selected_Component) then Note_Uplevel_Bound (Prefix (N), Ref); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 632c879892e..314e3ee97cd 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8402,26 +8402,23 @@ package body Exp_Util is declare Align_In_Bits : constant Nat := M * System_Storage_Unit; - Off : Uint; - Siz : Uint; + Comp : Entity_Id; + begin + Comp := C; + -- For a component inherited in a record extension, the -- clause is inherited but position and size are not set. if Is_Base_Type (Etype (P)) and then Is_Tagged_Type (Etype (P)) - and then Present (Original_Record_Component (C)) + and then Present (Original_Record_Component (Comp)) then - Off := - Component_Bit_Offset (Original_Record_Component (C)); - Siz := Esize (Original_Record_Component (C)); - else - Off := Component_Bit_Offset (C); - Siz := Esize (C); + Comp := Original_Record_Component (Comp); end if; - if Off mod Align_In_Bits /= 0 - or else Siz mod Align_In_Bits /= 0 + if Component_Bit_Offset (Comp) mod Align_In_Bits /= 0 + or else Esize (Comp) mod Align_In_Bits /= 0 then return True; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index d7f3f58e33c..5036a7991ed 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3619,7 +3619,7 @@ package body Freeze is if Is_Access_Type (F_Type) and then Esize (F_Type) > Ttypes.System_Address_Size and then (not Unnest_Subprogram_Mode - or else not Is_Access_Subprogram_Type (F_Type)) + or else not Is_Access_Subprogram_Type (F_Type)) then Error_Msg_N ("?x?type of & does not correspond to C pointer!", Formal); @@ -7654,10 +7654,9 @@ package body Freeze is Expr : Node_Id; N : Node_Id) is - function Cloned_Expression return Node_Id; - -- Build a duplicate of the expression of the return statement that - -- has no defining entities shared with the original expression. + -- Build a duplicate of the expression of the return statement that has + -- no defining entities shared with the original expression. function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result; -- Freeze all types referenced in the subtree rooted at Node @@ -7680,8 +7679,8 @@ package body Freeze is if Nkind_In (Node, N_Iterator_Specification, N_Loop_Parameter_Specification) then - Set_Defining_Identifier (Node, - New_Copy (Defining_Identifier (Node))); + Set_Defining_Identifier + (Node, New_Copy (Defining_Identifier (Node))); end if; return OK; @@ -7741,9 +7740,9 @@ package body Freeze is return; end if; - -- This provides a better error message than generating - -- primitives whose compilation fails much later. Refine - -- the error message if possible. + -- This provides a better error message than generating primitives + -- whose compilation fails much later. Refine the error message if + -- possible. Check_Fully_Declared (Typ, Node); @@ -7773,10 +7772,10 @@ package body Freeze is Check_And_Freeze_Type (Scope (Entity (Node))); end if; - -- Freezing an access type does not freeze the designated type, - -- but freezing conversions between access to interfaces requires - -- that the interface types themselves be frozen, so that dispatch - -- table entities are properly created. + -- Freezing an access type does not freeze the designated type, but + -- freezing conversions between access to interfaces requires that + -- the interface types themselves be frozen, so that dispatch table + -- entities are properly created. -- Unclear whether a more general rule is needed ??? @@ -7787,10 +7786,10 @@ package body Freeze is Check_And_Freeze_Type (Designated_Type (Etype (Node))); end if; - -- An implicit dereference freezes the designated type. In the - -- case of a dispatching call whose controlling argument is an - -- access type, the dereference is not made explicit, so we must - -- check for such a call and freeze the designated type. + -- An implicit dereference freezes the designated type. In the case + -- of a dispatching call whose controlling argument is an access + -- type, the dereference is not made explicit, so we must check for + -- such a call and freeze the designated type. if Nkind (Node) in N_Has_Etype and then Present (Etype (Node)) diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 16981b88d5c..5c8bb7da540 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -1103,9 +1103,9 @@ procedure Gnatlink is -- as it is in the same directory as the shared version. if Nlast >= Library_Version'Length - and then Next_Line - (Nlast - Library_Version'Length + 1 .. Nlast) - = Library_Version + and then + Next_Line (Nlast - Library_Version'Length + 1 .. Nlast) = + Library_Version then -- Set Last to point to last character before the -- library version. diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 23436c8dfd8..a7b24ab43c8 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -326,14 +326,13 @@ package body Layout is Init_Size (E, 2 * System_Address_Size); -- If unnesting subprograms, subprogram access types contain the - -- address of both the subprogram and an activation record. But - -- if we set that, we'll get a warning on different unchecked - -- conversion sizes in the RTS. So leave unset ub that case. + -- address of both the subprogram and an activation record. But if we + -- set that, we'll get a warning on different unchecked conversion + -- sizes in the RTS. So leave unset ub that case. elsif Unnest_Subprogram_Mode and then Is_Access_Subprogram_Type (E) then - -- Init_Size (E, 2 * System_Address_Size); null; -- Normal case of thin pointer diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index beb9489ef09..a4f952655f0 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -963,10 +963,11 @@ package body Lib.Writ is -- allow partial analysis on incomplete sources. if GNATprove_Mode then - Body_Fname := - Get_File_Name (Get_Body_Name (Uname), - Subunit => False, May_Fail => True); + Get_File_Name + (Uname => Get_Body_Name (Uname), + Subunit => False, + May_Fail => True); Body_Index := Get_Unit_Index (Get_Body_Name (Uname)); @@ -981,8 +982,10 @@ package body Lib.Writ is else Body_Fname := - Get_File_Name (Get_Body_Name (Uname), - Subunit => False, May_Fail => False); + Get_File_Name + (Uname => Get_Body_Name (Uname), + Subunit => False, + May_Fail => False); Body_Index := Get_Unit_Index (Get_Body_Name (Uname)); end if; diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index 00fe71aecf0..ce4538ba46b 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -228,6 +228,7 @@ package body SPARK_Specific is end loop; if Nkind (Context) = N_Pragma then + -- When used for cross-references then aspects might not be -- yet linked to pragmas; when used for AST navigation in -- GNATprove this routine is expected to follow those links. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 1a1262218aa..00854c9be58 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8754,6 +8754,7 @@ package body Sem_Ch13 is -- Case where predicates are present if Present (Expr) then + -- Test for raise expression present Test_REs (Expr); @@ -8764,44 +8765,45 @@ package body Sem_Ch13 is if Raise_Expression_Present then declare - Map : constant Elist_Id := New_Elmt_List; - New_V : Entity_Id := Empty; - - -- The unanalyzed expression will be copied and appear in - -- both functions. Normally expressions do not declare new - -- entities, but quantified expressions do, so we need to - -- create new entities for their bound variables, to prevent - -- multiple definitions in gigi. - - function Reset_Loop_Variable (N : Node_Id) - return Traverse_Result; + function Reset_Loop_Variable + (N : Node_Id) return Traverse_Result; - procedure Collect_Loop_Variables is + procedure Reset_Loop_Variables is new Traverse_Proc (Reset_Loop_Variable); ------------------------ -- Reset_Loop_Variable -- ------------------------ - function Reset_Loop_Variable (N : Node_Id) - return Traverse_Result + function Reset_Loop_Variable + (N : Node_Id) return Traverse_Result is begin if Nkind (N) = N_Iterator_Specification then - New_V := Make_Defining_Identifier - (Sloc (N), Chars (Defining_Identifier (N))); - - Set_Defining_Identifier (N, New_V); + Set_Defining_Identifier (N, + Make_Defining_Identifier + (Sloc (N), Chars (Defining_Identifier (N)))); end if; return OK; end Reset_Loop_Variable; + -- Local variables + + Map : constant Elist_Id := New_Elmt_List; + begin Append_Elmt (Object_Entity, Map); Append_Elmt (Object_Entity_M, Map); Expr_M := New_Copy_Tree (Expr, Map => Map); - Collect_Loop_Variables (Expr_M); + + -- The unanalyzed expression will be copied and appear in + -- both functions. Normally expressions do not declare new + -- entities, but quantified expressions do, so we need to + -- create new entities for their bound variables, to prevent + -- multiple definitions in gigi. + + Reset_Loop_Variables (Expr_M); end; end if; @@ -8862,8 +8864,8 @@ package body Sem_Ch13 is -- loops during analysis and expansion. declare - function Reset_Quantified_Variable_Scope (N : Node_Id) - return Traverse_Result; + function Reset_Quantified_Variable_Scope + (N : Node_Id) return Traverse_Result; procedure Reset_Quantified_Variables_Scope is new Traverse_Proc (Reset_Quantified_Variable_Scope); @@ -8872,8 +8874,8 @@ package body Sem_Ch13 is -- Reset_Quantified_Variable_Scope -- ------------------------------------- - function Reset_Quantified_Variable_Scope (N : Node_Id) - return Traverse_Result + function Reset_Quantified_Variable_Scope + (N : Node_Id) return Traverse_Result is begin if Nkind_In (N, N_Iterator_Specification, @@ -8882,6 +8884,7 @@ package body Sem_Ch13 is Set_Scope (Defining_Identifier (N), Predicate_Function (Typ)); end if; + return OK; end Reset_Quantified_Variable_Scope; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d12ccc9c9a9..cc84f9c3f2d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -13693,8 +13693,12 @@ package body Sem_Ch3 is Related_Nod : Node_Id) return Entity_Id is T_Sub : constant Entity_Id := - Create_Itype (E_Record_Subtype, - Related_Nod, Corr_Rec, 'C', Suffix_Index => -1); + Create_Itype + (Ekind => E_Record_Subtype, + Related_Nod => Related_Nod, + Related_Id => Corr_Rec, + Suffix => 'C', + Suffix_Index => -1); begin Set_Etype (T_Sub, Corr_Rec); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3e0cae1d886..b330426db5c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -398,7 +398,11 @@ package body Sem_Ch6 is -- As elsewhere, we do not emit freeze nodes within a generic unit. if not Inside_A_Generic then - Freeze_Expr_Types (Def_Id, Etype (Def_Id), Expr, N); + Freeze_Expr_Types + (Def_Id => Def_Id, + Typ => Etype (Def_Id), + Expr => Expr, + N => N); end if; -- For navigation purposes, indicate that the function is a body @@ -7241,16 +7245,16 @@ package body Sem_Ch6 is end if; end; - -- Functions can override abstract interface functions - -- Return types must be subtype conformant. + -- Functions can override abstract interface functions. Return + -- types must be subtype conformant. elsif Ekind (Def_Id) = E_Function and then Ekind (Subp) = E_Function and then Matches_Prefixed_View_Profile (Parameter_Specifications (Parent (Def_Id)), Parameter_Specifications (Parent (Subp))) - and then Conforming_Types (Etype (Def_Id), Etype (Subp), - Subtype_Conformant) + and then Conforming_Types + (Etype (Def_Id), Etype (Subp), Subtype_Conformant) then Candidate := Subp; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 5a1a9f7d4e3..2002b75876f 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6081,10 +6081,10 @@ package body Sem_Res is then if Is_Expression_Function (Entity (Subp)) then - -- Force freeze of expression function in call. + -- Force freeze of expression function in call Set_Comes_From_Source (Subp, True); - Set_Must_Not_Freeze (Subp, False); + Set_Must_Not_Freeze (Subp, False); end if; Freeze_Expression (Subp); @@ -6092,7 +6092,7 @@ package body Sem_Res is -- For a predefined operator, the type of the result is the type imposed -- by context, except for a predefined operation on universal fixed. - -- Otherwise The type of the call is the type returned by the subprogram + -- Otherwise the type of the call is the type returned by the subprogram -- being called. if Is_Predefined_Op (Nam) then @@ -6128,14 +6128,21 @@ package body Sem_Res is Ret_Type : constant Entity_Id := Etype (Nam); begin - -- If this is a parameterless call there is no ambiguity - -- and the call has the type of the function. + -- If this is a parameterless call there is no ambiguity and the + -- call has the type of the function. if No (First_Actual (N)) then Set_Etype (N, Etype (Nam)); + if Present (First_Formal (Nam)) then Resolve_Actuals (N, Nam); end if; + + -- Annotate the tree by creating a call marker in case the + -- original call is transformed by expansion. The call marker + -- is automatically saved for later examination by the ABE + -- Processing phase. + Build_Call_Marker (N); elsif Is_Access_Type (Ret_Type) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a8ea805d467..2b31cf752cb 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -24040,12 +24040,11 @@ package body Sem_Util is then return True; - -- OUtside of its scope, a synchronized type may just be - -- private. + -- Outside of its scope, a synchronized type may just be private elsif Is_Private_Type (Curr) and then Present (Full_View (Curr)) - and then Is_Concurrent_Type (Full_View (Curr)) + and then Is_Concurrent_Type (Full_View (Curr)) then return Scope_Within (Full_View (Curr), Outer); end if; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index ae296612ed3..1359c944670 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -4674,7 +4674,7 @@ package Sinfo is -------------------------- -- 4.5.7 If Expression -- - ---------------------------- + -------------------------- -- IF_EXPRESSION ::= -- if CONDITION then DEPENDENT_EXPRESSION diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 79788237b7f..ab7eecb7257 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -3540,17 +3540,14 @@ package body Sprint is -- where the aspects are printed inside the package specification. if Has_Aspects (Node) - and then not Nkind_In (Node, N_Package_Declaration, - N_Generic_Package_Declaration) - and then not Is_Empty_List (Aspect_Specifications (Node)) + and then not Nkind_In (Node, N_Generic_Package_Declaration, + N_Package_Declaration) and then not Is_Empty_List (Aspect_Specifications (Node)) then Sprint_Aspect_Specifications (Node, Semicolon => True); end if; - if Nkind (Node) in N_Subexpr - and then Do_Range_Check (Node) - then + if Nkind (Node) in N_Subexpr and then Do_Range_Check (Node) then Write_Str ("}"); end if; -- 2.30.2