[Ada] Improved performance of writable actuals aliasing detection

Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb	(revision 223661)
+++ sem_aggr.adb	(working copy)
@@ -1161,9 +1161,7 @@ 
          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 @@ 
          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;
 
    ------------------------------
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 223667)
+++ sem_ch3.adb	(working copy)
@@ -8955,9 +8955,7 @@ 
            (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 @@ 
          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;
 
    ----------------------------
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 223663)
+++ sem_util.adb	(working copy)
@@ -2324,11 +2324,12 @@ 
    --  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,
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 223663)
+++ sem_ch4.adb	(working copy)
@@ -65,6 +65,110 @@ 
 
 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 @@ 
       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 @@ 
       --  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 @@ 
                      --  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 @@ 
          --  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 @@ 
       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 @@ 
       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 @@ 
       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,11 +2913,8 @@ 
 
       if No (R) and then Ada_Version >= Ada_2012 then
          Analyze_Set_Membership;
+         Check_Function_Writable_Actuals (N);
 
-         if Check_Actuals (N) then
-            Check_Function_Writable_Actuals (N);
-         end if;
-
          return;
       end if;
 
@@ -2946,9 +2987,7 @@ 
          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 @@ 
          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;
 
    -----------------------