From f2c2cdfbdb3f1653c330945bc5b61a8da5a67881 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 17 Jul 2018 08:07:59 +0000 Subject: [PATCH] [Ada] Minor reformatting 2018-07-17 Hristian Kirtchev gcc/ada/ * exp_ch13.adb, exp_ch7.adb, exp_unst.adb, freeze.adb, libgnat/s-os_lib.adb, sem_ch3.adb, sem_ch3.ads, sem_ch5.adb, sem_eval.adb, sem_res.adb, sem_util.adb: Minor reformatting. From-SVN: r262786 --- gcc/ada/ChangeLog | 6 +++ gcc/ada/exp_ch13.adb | 2 +- gcc/ada/exp_ch7.adb | 66 +++++++++++++++------------ gcc/ada/exp_unst.adb | 8 ++-- gcc/ada/freeze.adb | 36 ++++++++------- gcc/ada/libgnat/s-os_lib.adb | 33 ++++++-------- gcc/ada/sem_ch3.adb | 3 ++ gcc/ada/sem_ch3.ads | 8 ++-- gcc/ada/sem_ch5.adb | 30 ++++++------ gcc/ada/sem_eval.adb | 2 +- gcc/ada/sem_res.adb | 4 +- gcc/ada/sem_util.adb | 88 +++++++++++++++++++----------------- 12 files changed, 153 insertions(+), 133 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a2075223678..c41693033a0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-07-17 Hristian Kirtchev + + * exp_ch13.adb, exp_ch7.adb, exp_unst.adb, freeze.adb, + libgnat/s-os_lib.adb, sem_ch3.adb, sem_ch3.ads, sem_ch5.adb, + sem_eval.adb, sem_res.adb, sem_util.adb: Minor reformatting. + 2018-07-17 Javier Miranda * exp_ch13.adb (Expand_N_Freeze_Entity): Handle subtype declared for an diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index 70e9327704c..4f95fc8275f 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -471,7 +471,7 @@ package body Exp_Ch13 is then E_Scope := Scope (E_Scope); - -- The entity may be a subtype declared for an iterator. + -- The entity may be a subtype declared for an iterator elsif Ekind (E_Scope) = E_Loop then E_Scope := Scope (E_Scope); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 781456fdfea..eb352c33bfb 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3989,14 +3989,11 @@ package body Exp_Ch7 is -------------------------------------- procedure Check_Unnesting_Elaboration_Code (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Elab_Body : Node_Id; - Elab_Call : Node_Id; - Elab_Proc : Entity_Id; - Stat : Node_Id; + Loc : constant Source_Ptr := Sloc (N); + function Contains_Subprogram (Blk : Entity_Id) return Boolean; - -- Check recursively whether a loop or block contains a subprogram - -- that may need an activation record. + -- Check recursively whether a loop or block contains a subprogram that + -- may need an activation record. -------------------------- -- Contains_Subprogram -- @@ -4004,6 +4001,7 @@ package body Exp_Ch7 is function Contains_Subprogram (Blk : Entity_Id) return Boolean is E : Entity_Id; + begin E := First_Entity (Blk); @@ -4023,6 +4021,15 @@ package body Exp_Ch7 is return False; end Contains_Subprogram; + -- Local variables + + Elab_Body : Node_Id; + Elab_Call : Node_Id; + Elab_Proc : Entity_Id; + Stat : Node_Id; + + -- Start of processing for Check_Unnesting_Elaboration_Code + begin if Unnest_Subprogram_Mode and then Present (Handled_Statement_Sequence (N)) @@ -8695,32 +8702,11 @@ package body Exp_Ch7 is Action : Node_Id; Par : Node_Id) return Node_Id is - function Within_Loop_Statement (N : Node_Id) return Boolean; - -- Return True when N appears within a loop and no block is containing N - function Manages_Sec_Stack (Id : Entity_Id) return Boolean; -- Determine whether scoping entity Id manages the secondary stack - --------------------------- - -- Within_Loop_Statement -- - --------------------------- - - function Within_Loop_Statement (N : Node_Id) return Boolean is - Par : Node_Id := Parent (N); - - begin - while not (Nkind_In (Par, - N_Loop_Statement, - N_Handled_Sequence_Of_Statements, - N_Package_Specification) - or else Nkind (Par) in N_Proper_Body) - loop - pragma Assert (Present (Par)); - Par := Parent (Par); - end loop; - - return Nkind (Par) = N_Loop_Statement; - end Within_Loop_Statement; + function Within_Loop_Statement (N : Node_Id) return Boolean; + -- Return True when N appears within a loop and no block is containing N ----------------------- -- Manages_Sec_Stack -- @@ -8751,6 +8737,26 @@ package body Exp_Ch7 is end case; end Manages_Sec_Stack; + --------------------------- + -- Within_Loop_Statement -- + --------------------------- + + function Within_Loop_Statement (N : Node_Id) return Boolean is + Par : Node_Id := Parent (N); + + begin + while not (Nkind_In (Par, N_Handled_Sequence_Of_Statements, + N_Loop_Statement, + N_Package_Specification) + or else Nkind (Par) in N_Proper_Body) + loop + pragma Assert (Present (Par)); + Par := Parent (Par); + end loop; + + return Nkind (Par) = N_Loop_Statement; + end Within_Loop_Statement; + -- Local variables Decls : constant List_Id := New_List; diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 12cb9bd656e..9f54eb2bd8d 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -711,11 +711,11 @@ package body Exp_Unst is procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id) is L : constant Nat := Get_Level (Subp, E); - -- Subprograms declared in tasks and protected types cannot - -- be eliminated because calls to them may be in other units, - -- so they must be treated as reachable. - begin + -- Subprograms declared in tasks and protected types cannot + -- be eliminated because calls to them may be in other units, + -- so they must be treated as reachable. + Subps.Append ((Ent => E, Bod => Bod, diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 691d6a5fe6c..c0da0eb3ccb 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -7027,13 +7027,14 @@ package body Freeze is -- Local variables In_Spec_Exp : constant Boolean := In_Spec_Expression; - Typ : Entity_Id; - Nam : Entity_Id; - Desig_Typ : Entity_Id; - P : Node_Id; - Parent_P : Node_Id; - Freeze_Outside : Boolean := False; + Desig_Typ : Entity_Id; + Nam : Entity_Id; + P : Node_Id; + Parent_P : Node_Id; + Typ : Entity_Id; + + Freeze_Outside : Boolean := False; -- This flag is set true if the entity must be frozen outside the -- current subprogram. This happens in the case of expander generated -- subprograms (_Init_Proc, _Input, _Output, _Read, _Write) which do @@ -7090,8 +7091,8 @@ package body Freeze is if not Is_Frozen (Etype (N)) then Typ := Etype (N); - -- Base type may be an derived numeric type that is frozen at - -- the point of declaration, but first_subtype is still unfrozen. + -- Base type may be an derived numeric type that is frozen at the + -- point of declaration, but first_subtype is still unfrozen. elsif not Is_Frozen (First_Subtype (Etype (N))) then Typ := First_Subtype (Etype (N)); @@ -7147,8 +7148,7 @@ package body Freeze is if Is_Array_Type (Etype (N)) and then Is_Access_Type (Component_Type (Etype (N))) then - - -- Check whether aggregate includes allocators. + -- Check whether aggregate includes allocators Desig_Typ := Find_Aggregate_Component_Desig_Type; end if; @@ -7224,7 +7224,7 @@ package body Freeze is end; end if; - -- Examine the enclosing context by climbing the parent chain. + -- Examine the enclosing context by climbing the parent chain -- If we identified that we must freeze the entity outside of a given -- subprogram then we just climb up to that subprogram checking if some @@ -7254,8 +7254,10 @@ package body Freeze is return; end if; - exit when Nkind (Parent_P) = N_Subprogram_Body - and then Unique_Defining_Entity (Parent_P) = Freeze_Outside_Subp; + exit when + Nkind (Parent_P) = N_Subprogram_Body + and then Unique_Defining_Entity (Parent_P) = + Freeze_Outside_Subp; P := Parent_P; end loop; @@ -7354,10 +7356,10 @@ package body Freeze is -- function call for overloading analysis purposes. elsif Nkind (Parent (N)) = N_Function_Call - and then - Nkind (Parent (Parent (N))) = N_Component_Association - and then - First (Choices (Parent (Parent (N)))) = Parent (N) + and then Nkind (Parent (Parent (N))) = + N_Component_Association + and then First (Choices (Parent (Parent (N)))) = + Parent (N) then return; end if; diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb index 1464206c83b..b896daf24f1 100644 --- a/gcc/ada/libgnat/s-os_lib.adb +++ b/gcc/ada/libgnat/s-os_lib.adb @@ -178,6 +178,7 @@ package body System.OS_Lib is return Len; end Args_Length; + ----------------------------- -- Argument_String_To_List -- ----------------------------- @@ -186,22 +187,22 @@ package body System.OS_Lib is (Arg_String : String) return Argument_List_Access is Max_Args : constant Integer := Arg_String'Length; - New_Argv : Argument_List (1 .. Max_Args); + + Backslash_Is_Sep : constant Boolean := Directory_Separator = '\'; + -- Whether '\' is a directory separator (as on Windows), or a way to + -- quote special characters. + + Backqd : Boolean := False; Idx : Integer; New_Argc : Natural := 0; - - Backqd : Boolean := False; - Quoted : Boolean := False; + New_Argv : Argument_List (1 .. Max_Args); + Quoted : Boolean := False; Cleaned : String (1 .. Arg_String'Length); Cleaned_Idx : Natural; -- A cleaned up version of the argument. This function is taking - -- backslash escapes when computing the bounds for arguments. It is - -- then removing the extra backslashes from the argument. - - Backslash_Is_Sep : constant Boolean := Directory_Separator = '\'; - -- Whether '\' is a directory separator (as on Windows), or a way to - -- quote special characters. + -- backslash escapes when computing the bounds for arguments. It + -- is then removing the extra backslashes from the argument. begin Idx := Arg_String'First; @@ -222,25 +223,19 @@ package body System.OS_Lib is loop -- An unquoted space is the end of an argument - if not (Backqd or Quoted) - and then Arg_String (Idx) = ' ' - then + if not (Backqd or Quoted) and then Arg_String (Idx) = ' ' then exit; -- Start of a quoted string - elsif not (Backqd or Quoted) - and then Arg_String (Idx) = '"' - then + elsif not (Backqd or Quoted) and then Arg_String (Idx) = '"' then Quoted := True; Cleaned (Cleaned_Idx) := Arg_String (Idx); Cleaned_Idx := Cleaned_Idx + 1; -- End of a quoted string and end of an argument - elsif (Quoted and not Backqd) - and then Arg_String (Idx) = '"' - then + elsif (Quoted and not Backqd) and then Arg_String (Idx) = '"' then Cleaned (Cleaned_Idx) := Arg_String (Idx); Cleaned_Idx := Cleaned_Idx + 1; Idx := Idx + 1; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index ad9d7e14d1b..349ece78761 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -19824,10 +19824,13 @@ package body Sem_Ch3 is procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id) is Save_In_Default_Expr : constant Boolean := In_Default_Expr; Save_In_Spec_Expression : constant Boolean := In_Spec_Expression; + begin In_Default_Expr := True; In_Spec_Expression := True; + Preanalyze_With_Freezing_And_Resolve (N, T); + In_Default_Expr := Save_In_Default_Expr; In_Spec_Expression := Save_In_Spec_Expression; end Preanalyze_Default_Expression; diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index c82ab860e77..70daae843e0 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -236,6 +236,10 @@ package Sem_Ch3 is -- Always False in Ada 95 mode. Equivalent to OK_For_Limited_Init_In_05 in -- Ada 2005 mode. + procedure Preanalyze_Assert_Expression (N : Node_Id; T : Entity_Id); + -- Wrapper on Preanalyze_Spec_Expression for assertion expressions, so that + -- In_Assertion_Expr can be properly adjusted. + procedure Preanalyze_Spec_Expression (N : Node_Id; T : Entity_Id); -- Default and per object expressions do not freeze their components, and -- must be analyzed and resolved accordingly. The analysis is done by @@ -246,10 +250,6 @@ package Sem_Ch3 is -- This mechanism is also used for aspect specifications that have an -- expression parameter that needs similar preanalysis. - procedure Preanalyze_Assert_Expression (N : Node_Id; T : Entity_Id); - -- Wrapper on Preanalyze_Spec_Expression for assertion expressions, so that - -- In_Assertion_Expr can be properly adjusted. - procedure Process_Full_View (N : Node_Id; Full_T, Priv_T : Entity_Id); -- Process some semantic actions when the full view of a private type is -- encountered and analyzed. The first action is to create the full views diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index ad592fb42c2..f35b37d9c36 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -3594,12 +3594,12 @@ package body Sem_Ch5 is and then not Is_Wrapped_In_Block (N) then declare - LPS : constant Node_Id := - Loop_Parameter_Specification (Iter); - DSD : constant Node_Id := - Original_Node (Discrete_Subtype_Definition (LPS)); - Block_Nod : Node_Id; + LPS : constant Node_Id := Loop_Parameter_Specification (Iter); + DSD : constant Node_Id := + Original_Node (Discrete_Subtype_Definition (LPS)); + Block_Id : Entity_Id; + Block_Nod : Node_Id; HB : Node_Id; LB : Node_Id; @@ -3607,23 +3607,25 @@ package body Sem_Ch5 is if Nkind (DSD) = N_Subtype_Indication and then Nkind (Range_Expression (Constraint (DSD))) = N_Range then - LB := New_Copy_Tree - (Low_Bound (Range_Expression (Constraint (DSD)))); - HB := New_Copy_Tree - (High_Bound (Range_Expression (Constraint (DSD)))); + LB := + New_Copy_Tree + (Low_Bound (Range_Expression (Constraint (DSD)))); + HB := + New_Copy_Tree + (High_Bound (Range_Expression (Constraint (DSD)))); Preanalyze (LB); Preanalyze (HB); if Has_Call_Using_Secondary_Stack (LB) - or else Has_Call_Using_Secondary_Stack (HB) + or else Has_Call_Using_Secondary_Stack (HB) then Block_Nod := Make_Block_Statement (Loc, - Declarations => New_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Relocate_Node (N)))); + Declarations => New_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List (Relocate_Node (N)))); Add_Block_Identifier (Block_Nod, Block_Id); Set_Uses_Sec_Stack (Block_Id); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 233f24dd48a..2bdf73d72de 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -2733,7 +2733,7 @@ package body Sem_Eval is -- Check_Non_Static_Context on an expanded literal may lead to spurious -- and misleading warnings. - if (Nkind_In (Par, N_If_Expression, N_Case_Expression_Alternative) + if (Nkind_In (Par, N_Case_Expression_Alternative, N_If_Expression) or else Nkind (Parent (N)) not in N_Subexpr) and then (not Nkind_In (Par, N_Case_Expression_Alternative, N_If_Expression) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 6bcfc389db8..b45e917a308 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1739,7 +1739,9 @@ package body Sem_Res is -- Preanalyze_With_Freezing_And_Resolve -- ------------------------------------------ - procedure Preanalyze_With_Freezing_And_Resolve (N : Node_Id; T : Entity_Id) + procedure Preanalyze_With_Freezing_And_Resolve + (N : Node_Id; + T : Entity_Id) is begin Preanalyze_And_Resolve (N, T, With_Freezing => True); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 31d5c1748d9..bfa2b4fb141 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6894,61 +6894,60 @@ package body Sem_Util is -------------------------- function Enclosing_Subprogram (E : Entity_Id) return Entity_Id is - Dynamic_Scope : constant Entity_Id := Enclosing_Dynamic_Scope (E); + Dyn_Scop : constant Entity_Id := Enclosing_Dynamic_Scope (E); begin - if Dynamic_Scope = Standard_Standard then + if Dyn_Scop = Standard_Standard then return Empty; - elsif Dynamic_Scope = Empty then + elsif Dyn_Scop = Empty then return Empty; - elsif Ekind (Dynamic_Scope) = E_Subprogram_Body then - return Corresponding_Spec (Parent (Parent (Dynamic_Scope))); + elsif Ekind (Dyn_Scop) = E_Subprogram_Body then + return Corresponding_Spec (Parent (Parent (Dyn_Scop))); - elsif Ekind_In (Dynamic_Scope, E_Block, E_Return_Statement) then - return Enclosing_Subprogram (Dynamic_Scope); + elsif Ekind_In (Dyn_Scop, E_Block, E_Return_Statement) then + return Enclosing_Subprogram (Dyn_Scop); - elsif Ekind (Dynamic_Scope) = E_Entry then + elsif Ekind (Dyn_Scop) = E_Entry then -- For a task entry, return the enclosing subprogram of the -- task itself. - if Ekind (Scope (Dynamic_Scope)) = E_Task_Type then - return Enclosing_Subprogram (Dynamic_Scope); + if Ekind (Scope (Dyn_Scop)) = E_Task_Type then + return Enclosing_Subprogram (Dyn_Scop); - -- A protected entry is rewritten as a protected procedure - -- which is the desired enclosing subprogram. This is relevant - -- when unnesting a procedure local to an entry body + -- A protected entry is rewritten as a protected procedure which is + -- the desired enclosing subprogram. This is relevant when unnesting + -- a procedure local to an entry body. else - return Protected_Body_Subprogram (Dynamic_Scope); + return Protected_Body_Subprogram (Dyn_Scop); end if; - elsif Ekind (Dynamic_Scope) = E_Task_Type then - return Get_Task_Body_Procedure (Dynamic_Scope); + elsif Ekind (Dyn_Scop) = E_Task_Type then + return Get_Task_Body_Procedure (Dyn_Scop); -- The scope may appear as a private type or as a private extension -- whose completion is a task or protected type. - elsif Ekind_In (Dynamic_Scope, - E_Limited_Private_Type, E_Record_Type_With_Private) - and then Present (Full_View (Dynamic_Scope)) - and then Ekind_In (Full_View (Dynamic_Scope), - E_Task_Type, E_Protected_Type) + elsif Ekind_In (Dyn_Scop, E_Limited_Private_Type, + E_Record_Type_With_Private) + and then Present (Full_View (Dyn_Scop)) + and then Ekind_In (Full_View (Dyn_Scop), E_Task_Type, E_Protected_Type) then - return Get_Task_Body_Procedure (Full_View (Dynamic_Scope)); + return Get_Task_Body_Procedure (Full_View (Dyn_Scop)); -- No body is generated if the protected operation is eliminated - elsif Convention (Dynamic_Scope) = Convention_Protected - and then not Is_Eliminated (Dynamic_Scope) - and then Present (Protected_Body_Subprogram (Dynamic_Scope)) + elsif Convention (Dyn_Scop) = Convention_Protected + and then not Is_Eliminated (Dyn_Scop) + and then Present (Protected_Body_Subprogram (Dyn_Scop)) then - return Protected_Body_Subprogram (Dynamic_Scope); + return Protected_Body_Subprogram (Dyn_Scop); else - return Dynamic_Scope; + return Dyn_Scop; end if; end Enclosing_Subprogram; @@ -8823,18 +8822,19 @@ package body Sem_Util is Assoc := First (Governed_By); Find_Constraint : loop Discrim := First (Choices (Assoc)); - exit Find_Constraint when Chars (Discrim_Name) = Chars (Discrim) - or else (Present (Corresponding_Discriminant (Entity (Discrim))) - and then - Chars (Corresponding_Discriminant (Entity (Discrim))) = - Chars (Discrim_Name)) - or else Chars (Original_Record_Component (Entity (Discrim))) - = Chars (Discrim_Name); + exit Find_Constraint when + Chars (Discrim_Name) = Chars (Discrim) + or else + (Present (Corresponding_Discriminant (Entity (Discrim))) + and then Chars (Corresponding_Discriminant + (Entity (Discrim))) = Chars (Discrim_Name)) + or else + Chars (Original_Record_Component (Entity (Discrim))) = + Chars (Discrim_Name); if No (Next (Assoc)) then - if not Is_Constrained (Typ) - and then Is_Derived_Type (Typ) - then + if not Is_Constrained (Typ) and then Is_Derived_Type (Typ) then + -- If the type is a tagged type with inherited discriminants, -- use the stored constraint on the parent in order to find -- the values of discriminants that are otherwise hidden by an @@ -8853,8 +8853,8 @@ package body Sem_Util is -- value. declare - D : Entity_Id; C : Elmt_Id; + D : Entity_Id; T : Entity_Id := Typ; begin @@ -8879,6 +8879,7 @@ package body Sem_Util is (New_Occurrence_Of (D, Sloc (Typ))), Duplicate_Subexpr_No_Checks (Node (C))); end if; + exit Find_Constraint; end if; @@ -8888,6 +8889,7 @@ package body Sem_Util is end if; -- Discriminant may be inherited from ancestor + T := Etype (T); end loop; end; @@ -8895,8 +8897,10 @@ package body Sem_Util is end if; if No (Next (Assoc)) then - Error_Msg_NE (" missing value for discriminant&", - First (Governed_By), Discrim_Name); + Error_Msg_NE + (" missing value for discriminant&", + First (Governed_By), Discrim_Name); + Report_Errors := True; return; end if; @@ -21043,8 +21047,8 @@ package body Sem_Util is ----------------- function Next_Actual (Actual_Id : Node_Id) return Node_Id is - N : Node_Id; Par : constant Node_Id := Parent (Actual_Id); + N : Node_Id; begin -- If we are pointing at a positional parameter, it is a member of a @@ -24029,7 +24033,7 @@ package body Sem_Util is then return True; - -- Ditto for the body of a protected operation. + -- Ditto for the body of a protected operation elsif Is_Subprogram (Curr) and then Outer = Protected_Body_Subprogram (Curr) -- 2.30.2