[multiple changes]

2015-05-26  Javier Miranda  <miranda@adacore.com>

	* 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  <ebotcazou@adacore.com>

	* 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

8 files changed, 268 insertions, 172 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index accd480..396f789 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,33 @@
+2015-05-26  Javier Miranda  <miranda@adacore.com>
+
+	* 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  <ebotcazou@adacore.com>
+
+	* 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  <dewar@adacore.com>
 
 	* aspects.ads, aspects.adb: Add aspect Disable_Controlled.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e89103c..78bd94c 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 046b189..d0c5d4e 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 01f4377..a7b942a 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 d38547d..f841b42 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 de8b1c4..54ea442 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 03fec8b..2da3fa6 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 57ec05c..dde6725 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,