From 22e89283f7807e9c1d17c5f817f2dca13bb544c1 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 26 May 2015 10:17:51 +0200 Subject: [PATCH] [multiple changes] 2015-05-26 Javier Miranda * sem_aggr.adb (Resolve_Aggregate, Resolve_Extension_Aggregate): Code cleanup. * sem_ch3.adb (Build_Derived_Record_Type, Record_Type_Declaration): Code cleanup. * sem_ch4.adb (Has_Arbitrary_Evaluation_Order, Stop_Subtree_Climbind): Tables which speed up the identification of dangerous calls to Ada 2012 functions with writable actuals (AI05-0144). (Analyze_Arithmetic_Op, Analyze_Call, Analyze_Comparison_Op, Analyze_Equality_Op, Analyze_Logical_Op, Analyze_Membership_Op, Analyze_Range): Code cleanup. (Is_Arbitrary_Evaluation_Order_Construct): Removed. (Check_Writable_Actuals): Code cleanup using the added tables. * sem_util.adb (Check_Function_Writable_Actuals): Return immediately if the node does not have the flag Check_Actuals set to True. 2015-05-26 Eric Botcazou * exp_ch6.adb (Add_Call_By_Copy_Code): Remove restrictive condition in the detection of the effects of Remove_Side_Effects. * exp_util.ads (Remove_Side_Effects): Add general and historical note. * exp_util.adb (Is_Name_Reference): New predicate. (Remove_Side_Effects): Use it in lieu of Is_Object_Reference in order to decide whether to use the renaming to capture the side effects of the subexpression. (Side_Effect_Free): Remove obsolete test. From-SVN: r223668 --- gcc/ada/ChangeLog | 30 +++++++ gcc/ada/exp_ch6.adb | 1 - gcc/ada/exp_util.adb | 165 ++++++++++++++++++++---------------- gcc/ada/exp_util.ads | 24 +++++- gcc/ada/sem_aggr.adb | 8 +- gcc/ada/sem_ch3.adb | 8 +- gcc/ada/sem_ch4.adb | 197 +++++++++++++++++++++++++------------------ gcc/ada/sem_util.adb | 7 +- 8 files changed, 268 insertions(+), 172 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index accd480b8f6..396f789b756 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2015-05-26 Javier Miranda + + * sem_aggr.adb (Resolve_Aggregate, Resolve_Extension_Aggregate): + Code cleanup. + * sem_ch3.adb (Build_Derived_Record_Type, + Record_Type_Declaration): Code cleanup. + * sem_ch4.adb (Has_Arbitrary_Evaluation_Order, + Stop_Subtree_Climbind): Tables which speed up the identification + of dangerous calls to Ada 2012 functions with writable actuals + (AI05-0144). + (Analyze_Arithmetic_Op, Analyze_Call, Analyze_Comparison_Op, + Analyze_Equality_Op, Analyze_Logical_Op, Analyze_Membership_Op, + Analyze_Range): Code cleanup. + (Is_Arbitrary_Evaluation_Order_Construct): Removed. + (Check_Writable_Actuals): Code cleanup using the added tables. + * sem_util.adb (Check_Function_Writable_Actuals): Return + immediately if the node does not have the flag Check_Actuals + set to True. + +2015-05-26 Eric Botcazou + + * exp_ch6.adb (Add_Call_By_Copy_Code): Remove restrictive + condition in the detection of the effects of Remove_Side_Effects. + * exp_util.ads (Remove_Side_Effects): Add general and historical note. + * exp_util.adb (Is_Name_Reference): New predicate. + (Remove_Side_Effects): Use it in lieu of Is_Object_Reference + in order to decide whether to use the renaming to capture the + side effects of the subexpression. + (Side_Effect_Free): Remove obsolete test. + 2015-05-26 Robert Dewar * aspects.ads, aspects.adb: Add aspect Disable_Controlled. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index e89103ce3f1..78bd94cdc86 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1257,7 +1257,6 @@ package body Exp_Ch6 is begin if Is_Renaming_Of_Object (Var) and then Nkind (Renamed_Object (Var)) = N_Selected_Component - and then Is_Entity_Name (Prefix (Renamed_Object (Var))) and then Nkind (Original_Node (Prefix (Renamed_Object (Var)))) = N_Indexed_Component and then diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 046b1891728..d0c5d4ee055 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7428,6 +7428,12 @@ package body Exp_Util is -- is present (xxx is taken from the Chars field of Related_Nod), -- otherwise it generates an internal temporary. + function Is_Name_Reference (N : Node_Id) return Boolean; + -- Determine if the tree referenced by N represents a name. This is + -- similar to Is_Object_Reference but returns true only if N can be + -- renamed without the need for a temporary, the typical example of + -- an object not in this category being a function call. + --------------------- -- Build_Temporary -- --------------------- @@ -7458,6 +7464,58 @@ package body Exp_Util is end if; end Build_Temporary; + ----------------------- + -- Is_Name_Reference -- + ----------------------- + + function Is_Name_Reference (N : Node_Id) return Boolean is + begin + if Is_Entity_Name (N) then + return Present (Entity (N)) and then Is_Object (Entity (N)); + end if; + + case Nkind (N) is + when N_Indexed_Component | N_Slice => + return + Is_Name_Reference (Prefix (N)) + or else Is_Access_Type (Etype (Prefix (N))); + + -- Attributes 'Input, 'Old and 'Result produce objects + + when N_Attribute_Reference => + return + Nam_In + (Attribute_Name (N), Name_Input, Name_Old, Name_Result); + + when N_Selected_Component => + return + Is_Name_Reference (Selector_Name (N)) + and then + (Is_Name_Reference (Prefix (N)) + or else Is_Access_Type (Etype (Prefix (N)))); + + when N_Explicit_Dereference => + return True; + + -- A view conversion of a tagged name is a name reference + + when N_Type_Conversion => + return Is_Tagged_Type (Etype (Subtype_Mark (N))) + and then Is_Tagged_Type (Etype (Expression (N))) + and then Is_Name_Reference (Expression (N)); + + -- An unchecked type conversion is considered to be a name if + -- the operand is a name (this construction arises only as a + -- result of expansion activities). + + when N_Unchecked_Type_Conversion => + return Is_Name_Reference (Expression (N)); + + when others => + return False; + end case; + end Is_Name_Reference; + -- Local variables Loc : constant Source_Ptr := Sloc (Exp); @@ -7498,34 +7556,25 @@ package body Exp_Util is return; end if; - -- The remaining procesaing is done with all checks suppressed + -- The remaining processing is done with all checks suppressed -- Note: from now on, don't use return statements, instead do a goto -- Leave, to ensure that we properly restore Scope_Suppress.Suppress. Scope_Suppress.Suppress := (others => True); - -- If it is a scalar type and we need to capture the value, just make - -- a copy. Likewise for a function call, an attribute reference, a - -- conditional expression, an allocator, or an operator. And if we have - -- a volatile reference and Name_Req is not set (see comments for - -- Side_Effect_Free). + -- If it is an elementary type and we need to capture the value, just + -- make a constant. Likewise if this is not a name reference, except + -- for a type conversion because we would enter an infinite recursion + -- with Checks.Apply_Predicate_Check if the target type has predicates. + -- And type conversions need a specific treatment anyway, see below. + -- Also do it if we have a volatile reference and Name_Req is not set + -- (see comments for Side_Effect_Free). if Is_Elementary_Type (Exp_Type) - - -- Note: this test is rather mysterious??? Why can't we just test ONLY - -- Is_Elementary_Type and be done with it. If we try that approach, we - -- get some failures (infinite recursions) from the Duplicate_Subexpr - -- call at the end of Checks.Apply_Predicate_Check. To be - -- investigated ??? - and then (Variable_Ref - or else Nkind_In (Exp, N_Attribute_Reference, - N_Allocator, - N_Case_Expression, - N_If_Expression, - N_Function_Call) - or else Nkind (Exp) in N_Op + or else (not Is_Name_Reference (Exp) + and then Nkind (Exp) /= N_Type_Conversion) or else (not Name_Req and then Is_Volatile_Reference (Exp))) then @@ -7645,20 +7694,13 @@ package body Exp_Util is Insert_Action (Exp, E); end if; - -- For expressions that denote objects, we can use a renaming scheme. + -- For expressions that denote names, we can use a renaming scheme. -- This is needed for correctness in the case of a volatile object of -- a non-volatile type because the Make_Reference call of the "default" -- approach would generate an illegal access value (an access value -- cannot designate such an object - see Analyze_Reference). - elsif Is_Object_Reference (Exp) - and then Nkind (Exp) /= N_Function_Call - - -- In Ada 2012 a qualified expression is an object, but for purposes - -- of removing side effects it still need to be transformed into a - -- separate declaration, particularly in the case of an aggregate. - - and then Nkind (Exp) /= N_Qualified_Expression + elsif Is_Name_Reference (Exp) -- We skip using this scheme if we have an object of a volatile -- type and we do not have Name_Req set true (see comments for @@ -7667,37 +7709,13 @@ package body Exp_Util is and then (Name_Req or else not Treat_As_Volatile (Exp_Type)) then Def_Id := Build_Temporary (Loc, 'R', Exp); + Res := New_Occurrence_Of (Def_Id, Loc); - if Nkind (Exp) = N_Selected_Component - and then Nkind (Prefix (Exp)) = N_Function_Call - and then Is_Array_Type (Exp_Type) - then - -- Avoid generating a variable-sized temporary, by generating - -- the renaming declaration just for the function call. The - -- transformation could be refined to apply only when the array - -- component is constrained by a discriminant??? - - Res := - Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (Def_Id, Loc), - Selector_Name => Selector_Name (Exp)); - - Insert_Action (Exp, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Def_Id, - Subtype_Mark => - New_Occurrence_Of (Base_Type (Etype (Prefix (Exp))), Loc), - Name => Relocate_Node (Prefix (Exp)))); - - else - Res := New_Occurrence_Of (Def_Id, Loc); - - Insert_Action (Exp, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Def_Id, - Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), - Name => Relocate_Node (Exp))); - end if; + Insert_Action (Exp, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Def_Id, + Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), + Name => Relocate_Node (Exp))); -- If this is a packed reference, or a selected component with -- a non-standard representation, a reference to the temporary @@ -7715,7 +7733,19 @@ package body Exp_Util is Set_Is_Renaming_Of_Object (Def_Id, False); end if; - -- Otherwise we generate a reference to the value + -- Avoid generating a variable-sized temporary, by generating the + -- reference just for the function call. The transformation could be + -- refined to apply only when the array component is constrained by a + -- discriminant??? + + elsif Nkind (Exp) = N_Selected_Component + and then Nkind (Prefix (Exp)) = N_Function_Call + and then Is_Array_Type (Exp_Type) + then + Remove_Side_Effects (Prefix (Exp), Name_Req, Variable_Ref); + goto Leave; + + -- Otherwise we generate a reference to the expression else -- An expression which is in SPARK mode is considered side effect @@ -8974,23 +9004,10 @@ package body Exp_Util is return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref); -- A selected component is side effect free only if it is a side - -- effect free prefixed reference. If it designates a component - -- with a rep. clause it must be treated has having a potential - -- side effect, because it may be modified through a renaming, and - -- a subsequent use of the renaming as a macro will yield the - -- wrong value. This complex interaction between renaming and - -- removing side effects is a reminder that the latter has become - -- a headache to maintain, and that it should be removed in favor - -- of the gcc mechanism to capture values ??? + -- effect free prefixed reference. when N_Selected_Component => - if Nkind (Parent (N)) = N_Explicit_Dereference - and then Has_Non_Standard_Rep (Designated_Type (Typ)) - then - return False; - else - return Safe_Prefixed_Reference (N); - end if; + return Safe_Prefixed_Reference (N); -- A range is side effect free if the bounds are side effect free diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 01f43777c43..a7b942a7569 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -872,8 +872,8 @@ package Exp_Util is -- call and is analyzed and resolved on return. Name_Req may only be set to -- True if Exp has the form of a name, and the effect is to guarantee that -- any replacement maintains the form of name. If Renaming_Req is set to - -- TRUE, the routine produces an object renaming reclaration capturing the - -- expression. If Variable_Ref is set to TRUE, a variable is considered as + -- True, the routine produces an object renaming reclaration capturing the + -- expression. If Variable_Ref is set to True, a variable is considered as -- side effect (used in implementing Force_Evaluation). Note: after call to -- Remove_Side_Effects, it is safe to call New_Copy_Tree to obtain a copy -- of the resulting expression. @@ -885,6 +885,26 @@ package Exp_Util is -- Chars (Related_Id)_FIRST/_LAST. If Related_Id is set, then exactly one -- of the Is_xxx_Bound flags must be set. For use of these parameters see -- the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. + -- + -- The side effects are captured using one of the following methods: + -- + -- 1) a constant initialized with the value of the subexpression + -- 2) a renaming of the subexpression + -- 3) a reference to the subexpression + -- + -- For elementary types, methods 1) and 2) are used; for composite types, + -- methods 2) and 3) are used. The renaming (method 2) is used only when + -- the subexpression denotes a name, so that it can be elaborated by gigi + -- without evaluating the subexpression. + -- + -- Historical note: the reference (method 3) used to be the common fallback + -- method but it gives rise to aliasing issues if the subexpression denotes + -- a name that is not aliased, since it is equivalent to taking the address + -- in this case. The renaming (method 2) used to be applied to any objects + -- in the RM sense, that is to say to the cases where a renaming is legal + -- in Ada. But for some of these cases, most notably functions calls, the + -- renaming cannot be elaborated without evaluating the subexpression, so + -- gigi would resort to method 1) or 3) under the hood for them. function Represented_As_Scalar (T : Entity_Id) return Boolean; -- Returns True iff the implementation of this type in code generation diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d38547d701c..f841b422e50 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1161,9 +1161,7 @@ package body Sem_Aggr is Set_Analyzed (N); end if; - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Resolve_Aggregate; ----------------------------- @@ -2906,9 +2904,7 @@ package body Sem_Aggr is Error_Msg_N ("no unique type for this aggregate", A); end if; - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Resolve_Extension_Aggregate; ------------------------------ diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index de8b1c4add5..54ea4429f9a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -8955,9 +8955,7 @@ package body Sem_Ch3 is (Class_Wide_Type (Derived_Type), Last_Entity (Derived_Type)); end if; - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Build_Derived_Record_Type; ------------------------ @@ -21122,9 +21120,7 @@ package body Sem_Ch3 is Derive_Progenitor_Subprograms (T, T); end if; - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Record_Type_Declaration; ---------------------------- diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 03fec8b9894..2da3fa6735f 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -65,6 +65,110 @@ with Uintp; use Uintp; package body Sem_Ch4 is + -- Tables which speed up the identification of dangerous calls to Ada 2012 + -- functions with writable actuals (AI05-0144). + + -- The following table enumerates the Ada constructs which may evaluate in + -- arbitrary order. It does not cover all the language constructs which can + -- be evaluated in arbitrary order but the subset needed for AI05-0144. + + Has_Arbitrary_Evaluation_Order : constant array (Node_Kind) of Boolean := + (N_Aggregate => True, + N_Assignment_Statement => True, + N_Entry_Call_Statement => True, + N_Extension_Aggregate => True, + N_Full_Type_Declaration => True, + N_Indexed_Component => True, + N_Object_Declaration => True, + N_Pragma => True, + N_Range => True, + N_Slice => True, + + -- N_Array_Type_Definition + + -- why not + -- N_Array_Type_Definition => True, + -- etc ??? + + N_Constrained_Array_Definition => True, + N_Unconstrained_Array_Definition => True, + + -- N_Membership_Test + + N_In => True, + N_Not_In => True, + + -- N_Binary_Op + + N_Op_Add => True, + N_Op_Concat => True, + N_Op_Expon => True, + N_Op_Subtract => True, + + N_Op_Divide => True, + N_Op_Mod => True, + N_Op_Multiply => True, + N_Op_Rem => True, + + N_Op_And => True, + + N_Op_Eq => True, + N_Op_Ge => True, + N_Op_Gt => True, + N_Op_Le => True, + N_Op_Lt => True, + N_Op_Ne => True, + + N_Op_Or => True, + N_Op_Xor => True, + + N_Op_Rotate_Left => True, + N_Op_Rotate_Right => True, + N_Op_Shift_Left => True, + N_Op_Shift_Right => True, + N_Op_Shift_Right_Arithmetic => True, + + N_Op_Not => True, + N_Op_Plus => True, + + -- N_Subprogram_Call + + N_Function_Call => True, + N_Procedure_Call_Statement => True, + + others => False); + + -- The following table enumerates the nodes on which we stop climbing when + -- locating the outermost Ada construct that can be evaluated in arbitrary + -- order. + + Stop_Subtree_Climbing : constant array (Node_Kind) of Boolean := + (N_Aggregate => True, + N_Assignment_Statement => True, + N_Entry_Call_Statement => True, + N_Extended_Return_Statement => True, + N_Extension_Aggregate => True, + N_Full_Type_Declaration => True, + N_Object_Declaration => True, + N_Object_Renaming_Declaration => True, + N_Package_Specification => True, + N_Pragma => True, + N_Procedure_Call_Statement => True, + N_Simple_Return_Statement => True, + + -- N_Has_Condition + + N_Exit_Statement => True, + N_If_Statement => True, + + N_Accept_Alternative => True, + N_Delay_Alternative => True, + N_Elsif_Part => True, + N_Entry_Body_Formal_Part => True, + N_Iteration_Scheme => True, + + others => False); + ----------------------- -- Local Subprograms -- ----------------------- @@ -830,10 +934,7 @@ package body Sem_Ch4 is end if; Operator_Check (N); - - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Analyze_Arithmetic_Op; ------------------ @@ -945,40 +1046,6 @@ package body Sem_Ch4 is -- enabled. procedure Check_Writable_Actuals (N : Node_Id) is - - function Is_Arbitrary_Evaluation_Order_Construct - (N : Node_Id) return Boolean; - -- Return True if N is an Ada construct which may be evaluated in - -- an arbitrary order. This function does not cover all the language - -- constructs that can be evaluated in arbitrary order, but only the - -- subset needed for AI05-0144. - - --------------------------------------------- - -- Is_Arbitrary_Evaluation_Order_Construct -- - --------------------------------------------- - - function Is_Arbitrary_Evaluation_Order_Construct - (N : Node_Id) return Boolean is - begin - return Nkind (N) = N_Aggregate - or else Nkind (N) = N_Assignment_Statement - or else Nkind (N) = N_Full_Type_Declaration - or else Nkind (N) = N_Entry_Call_Statement - or else Nkind (N) = N_Extension_Aggregate - or else Nkind (N) = N_Indexed_Component - or else Nkind (N) = N_Object_Declaration - or else Nkind (N) = N_Pragma - or else Nkind (N) = N_Range - or else Nkind (N) = N_Slice - - or else Nkind (N) in N_Array_Type_Definition - or else Nkind (N) in N_Membership_Test - or else Nkind (N) in N_Op - or else Nkind (N) in N_Subprogram_Call; - end Is_Arbitrary_Evaluation_Order_Construct; - - -- Start of processing for Check_Writable_Actuals - begin if Comes_From_Source (N) and then Present (Get_Subprogram_Entity (N)) @@ -1010,31 +1077,19 @@ package body Sem_Ch4 is -- to the routine that will later take care of -- performing the writable actuals check. - if Is_Arbitrary_Evaluation_Order_Construct (P) - and then Nkind (P) /= N_Assignment_Statement - and then Nkind (P) /= N_Object_Declaration + if Has_Arbitrary_Evaluation_Order (Nkind (P)) + and then not Nkind_In (P, N_Assignment_Statement, + N_Object_Declaration) then Outermost := P; end if; -- Avoid climbing more than needed! - exit when Nkind (P) = N_Aggregate - or else Nkind (P) = N_Assignment_Statement - or else Nkind (P) = N_Entry_Call_Statement - or else Nkind (P) = N_Extended_Return_Statement - or else Nkind (P) = N_Extension_Aggregate - or else Nkind (P) = N_Full_Type_Declaration - or else Nkind (P) = N_Object_Declaration - or else Nkind (P) = N_Object_Renaming_Declaration - or else Nkind (P) = N_Package_Specification - or else Nkind (P) = N_Pragma - or else Nkind (P) = N_Procedure_Call_Statement - or else Nkind (P) = N_Simple_Return_Statement + exit when Stop_Subtree_Climbing (Nkind (P)) or else (Nkind (P) = N_Range and then not - Nkind_In (Parent (P), N_In, N_Not_In)) - or else Nkind (P) in N_Has_Condition; + Nkind_In (Parent (P), N_In, N_Not_In)); P := Parent (P); end loop; @@ -1411,9 +1466,7 @@ package body Sem_Ch4 is -- an arbitrary order is precisely this call, then check all its -- actuals. - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end if; end Analyze_Call; @@ -1632,10 +1685,7 @@ package body Sem_Ch4 is end if; Operator_Check (N); - - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Analyze_Comparison_Op; --------------------------- @@ -1883,10 +1933,7 @@ package body Sem_Ch4 is end if; Operator_Check (N); - - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Analyze_Equality_Op; ---------------------------------- @@ -2710,10 +2757,7 @@ package body Sem_Ch4 is end if; Operator_Check (N); - - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Analyze_Logical_Op; --------------------------- @@ -2869,10 +2913,7 @@ package body Sem_Ch4 is if No (R) and then Ada_Version >= Ada_2012 then Analyze_Set_Membership; - - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); return; end if; @@ -2946,9 +2987,7 @@ package body Sem_Ch4 is Error_Msg_N ("membership test not applicable to cpp-class types", N); end if; - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Analyze_Membership_Op; ----------------- @@ -4028,9 +4067,7 @@ package body Sem_Ch4 is Check_Universal_Expression (H); end if; - if Check_Actuals (N) then - Check_Function_Writable_Actuals (N); - end if; + Check_Function_Writable_Actuals (N); end Analyze_Range; ----------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 57ec05c5698..dde67258d25 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2324,11 +2324,12 @@ package body Sem_Util is -- Start of processing for Check_Function_Writable_Actuals begin - -- The check only applies to Ada 2012 code, and only to constructs that - -- have multiple constituents whose order of evaluation is not specified - -- by the language. + -- The check only applies to Ada 2012 code on which Check_Actuals has + -- been set, and only to constructs that have multiple constituents + -- whose order of evaluation is not specified by the language. if Ada_Version < Ada_2012 + or else not Check_Actuals (N) or else (not (Nkind (N) in N_Op) and then not (Nkind (N) in N_Membership_Test) and then not Nkind_In (N, N_Range, -- 2.30.2