2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>

	* sem_res.adb (Flag_Effectively_Volatile_Objects): New routine.
	(Resolve_Actuals): Flag effectively volatile objects with enabled
	property Async_Writers or Effective_Reads as illegal.
	* sem_util.adb (Is_OK_Volatile_Context): Comment reformatting.

2016-04-27  Javier Miranda  <miranda@adacore.com>

	* exp_ch3.adb (Make_Predefined_Primitive_Specs):
	Do not generate the profile of the equality operator if it has
	been explicitly defined as abstract in the parent type. Required
	to avoid reporting an spurious error.

2016-04-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_dim.ads, sem_dim.adb (Check_Expression_Dimensions): New
	procedure to compute the dimension vector of a scalar expression
	and compare it with the dimensions if its expected subtype. Used
	for the ultimate components of a multidimensional aggregate,
	whose components typically are themselves aggregates that are
	expanded separately. Previous to this patch, dimensionality
	checking on such aggregates generated spurious errors.
	* sem_aggr.adb (Resolve_Array_Aggregate): Use
	Check_Expression_Dimensions when needed.

2016-04-27  Javier Miranda  <miranda@adacore.com>

	* einfo.ads, einfo.adb (Corresponding_Function): New attribute
	(applicable to E_Procedure).
	(Corresponding_Procedure): New attribute (applicable to E_Function).
	* exp_util.adb (Build_Procedure_Form): Link the function with
	its internally built proc and viceversa.
	* sem_ch6.adb (Build_Subprogram_Declaration): Propagate the
	attribute Rewritten_For_C and Corresponding_Procedure to the body.
	* exp_ch6.adb (Rewritten_For_C_Func_Id): Removed.
	(Rewritten_For_C_Proc_Id): Removed.
	* exp_unst.adb (Note_Uplevel_Ref): Use the new attribute to
	locate the corresponding procedure.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@235493 138bc75d-0d04-0410-961f-82ee72b054a4

13 files changed, 267 insertions, 130 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4b39a4d8542..eb0f5ae046f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,45 @@
 2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* sem_res.adb (Flag_Effectively_Volatile_Objects): New routine.
+	(Resolve_Actuals): Flag effectively volatile objects with enabled
+	property Async_Writers or Effective_Reads as illegal.
+	* sem_util.adb (Is_OK_Volatile_Context): Comment reformatting.
+
+2016-04-27  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch3.adb (Make_Predefined_Primitive_Specs):
+	Do not generate the profile of the equality operator if it has
+	been explicitly defined as abstract in the parent type. Required
+	to avoid reporting an spurious error.
+
+2016-04-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_dim.ads, sem_dim.adb (Check_Expression_Dimensions): New
+	procedure to compute the dimension vector of a scalar expression
+	and compare it with the dimensions if its expected subtype. Used
+	for the ultimate components of a multidimensional aggregate,
+	whose components typically are themselves aggregates that are
+	expanded separately. Previous to this patch, dimensionality
+	checking on such aggregates generated spurious errors.
+	* sem_aggr.adb (Resolve_Array_Aggregate): Use
+	Check_Expression_Dimensions when needed.
+
+2016-04-27  Javier Miranda  <miranda@adacore.com>
+
+	* einfo.ads, einfo.adb (Corresponding_Function): New attribute
+	(applicable to E_Procedure).
+	(Corresponding_Procedure): New attribute (applicable to E_Function).
+	* exp_util.adb (Build_Procedure_Form): Link the function with
+	its internally built proc and viceversa.
+	* sem_ch6.adb (Build_Subprogram_Declaration): Propagate the
+	attribute Rewritten_For_C and Corresponding_Procedure to the body.
+	* exp_ch6.adb (Rewritten_For_C_Func_Id): Removed.
+	(Rewritten_For_C_Proc_Id): Removed.
+	* exp_unst.adb (Note_Uplevel_Ref): Use the new attribute to
+	locate the corresponding procedure.
+
+2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* sem_ch13.adb (Analyze_Aspect_Export_Import): Signal that there is no
 	corresponding pragma.
 
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 7172a2ac518..32a56a6f8f1 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -256,6 +256,8 @@ package body Einfo is
    --    Thunk_Entity                    Node31
    --    Activation_Record_Component     Node31
 
+   --    Corresponding_Function          Node32
+   --    Corresponding_Procedure         Node32
    --    Encapsulating_State             Node32
    --    No_Tagged_Streams_Pragma        Node32
 
@@ -915,6 +917,18 @@ package body Einfo is
       return Node30 (Id);
    end Corresponding_Equality;
 
+   function Corresponding_Function (Id : E) return E is
+   begin
+      pragma Assert (Ekind (Id) = E_Procedure);
+      return Node32 (Id);
+   end Corresponding_Function;
+
+   function Corresponding_Procedure (Id : E) return E is
+   begin
+      pragma Assert (Ekind (Id) = E_Function);
+      return Node32 (Id);
+   end Corresponding_Procedure;
+
    function Corresponding_Protected_Entry (Id : E) return E is
    begin
       pragma Assert (Ekind (Id) = E_Subprogram_Body);
@@ -3919,6 +3933,22 @@ package body Einfo is
       Set_Node30 (Id, V);
    end Set_Corresponding_Equality;
 
+   procedure Set_Corresponding_Function (Id : E; V : E) is
+   begin
+      pragma Assert
+        (Ekind (Id) = E_Procedure
+          and then Rewritten_For_C (V));
+      Set_Node32 (Id, V);
+   end Set_Corresponding_Function;
+
+   procedure Set_Corresponding_Procedure (Id : E; V : E) is
+   begin
+      pragma Assert
+        (Ekind (Id) = E_Function
+          and then Rewritten_For_C (Id));
+      Set_Node32 (Id, V);
+   end Set_Corresponding_Procedure;
+
    procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
    begin
       pragma Assert (Ekind_In (Id, E_Void, E_Subprogram_Body));
@@ -10276,6 +10306,12 @@ package body Einfo is
               E_Variable                                   =>
             Write_Str ("Encapsulating_State");
 
+         when E_Function                                   =>
+            Write_Str ("Corresponding_Procedure");
+
+         when E_Procedure                                  =>
+            Write_Str ("Corresponding_Function");
+
          when Type_Kind                                    =>
             Write_Str ("No_Tagged_Streams_Pragma");
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 84ce2e2cb24..e8cee391b5f 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -738,6 +738,17 @@ package Einfo is
 --       other function entities, only in implicit inequality routines,
 --       where Comes_From_Source is always False.
 
+--    Corresponding_Function (Node32)
+--       Defined on procedures internally built with an extra out parameter
+--       to return a constrained array type, when Modify_Tree_For_C is set.
+--       Denotes the function that returns the constrained array type for
+--       which this procedure was built.
+
+--    Corresponding_Procedure (Node32)
+--       Defined on functions that return a constrained array type, when
+--       Modify_Tree_For_C is set. Denotes the internally built procedure
+--       with an extra out parameter created for it.
+
 --    Corresponding_Protected_Entry (Node18)
 --       Defined in subprogram bodies. Set for subprogram bodies that implement
 --       a protected type entry to point to the entity for the entry.
@@ -5888,6 +5899,7 @@ package Einfo is
    --    Subprograms_For_Type                (Node29)
    --    Corresponding_Equality              (Node30)   (implicit /= only)
    --    Thunk_Entity                        (Node31)   (thunk case only)
+   --    Corresponding_Procedure             (Node32)   (generate C code only)
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
@@ -5938,7 +5950,7 @@ package Einfo is
    --    Return_Present                      (Flag54)
    --    Returns_By_Ref                      (Flag90)
    --    Returns_Limited_View                (Flag134)  (non-generic case only)
-   --    Rewritten_For_C                     (Flag287)
+   --    Rewritten_For_C                     (Flag287)  (generate C code only)
    --    Sec_Stack_Needed_For_Return         (Flag167)
    --    SPARK_Pragma_Inherited              (Flag265)
    --    Uses_Sec_Stack                      (Flag95)
@@ -6201,6 +6213,7 @@ package Einfo is
    --    Extra_Formals                       (Node28)
    --    Static_Initialization               (Node30)   (init_proc only)
    --    Thunk_Entity                        (Node31)   (thunk case only)
+   --    Corresponding_Function              (Node32)   (generate C code only)
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
@@ -6774,6 +6787,8 @@ package Einfo is
    function Corresponding_Concurrent_Type       (Id : E) return E;
    function Corresponding_Discriminant          (Id : E) return E;
    function Corresponding_Equality              (Id : E) return E;
+   function Corresponding_Function              (Id : E) return E;
+   function Corresponding_Procedure             (Id : E) return E;
    function Corresponding_Protected_Entry       (Id : E) return E;
    function Corresponding_Record_Type           (Id : E) return E;
    function Corresponding_Remote_Type           (Id : E) return E;
@@ -7441,6 +7456,8 @@ package Einfo is
    procedure Set_Corresponding_Concurrent_Type   (Id : E; V : E);
    procedure Set_Corresponding_Discriminant      (Id : E; V : E);
    procedure Set_Corresponding_Equality          (Id : E; V : E);
+   procedure Set_Corresponding_Function          (Id : E; V : E);
+   procedure Set_Corresponding_Procedure         (Id : E; V : E);
    procedure Set_Corresponding_Protected_Entry   (Id : E; V : E);
    procedure Set_Corresponding_Record_Type       (Id : E; V : E);
    procedure Set_Corresponding_Remote_Type       (Id : E; V : E);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index e76db7eeeb7..5f6e3cd9eb1 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -9637,11 +9637,13 @@ package body Exp_Ch3 is
                   exit;
 
                --  If the parent is not an interface type and has an abstract
-               --  equality function, the inherited equality is abstract as
-               --  well, and no body can be created for it.
+               --  equality function explicitly defined in the sources, then
+               --  the inherited equality is abstract as well, and no body can
+               --  be created for it.
 
                elsif not Is_Interface (Etype (Tag_Typ))
                  and then Present (Alias (Node (Prim)))
+                 and then Comes_From_Source (Alias (Node (Prim)))
                  and then Is_Abstract_Subprogram (Alias (Node (Prim)))
                then
                   Eq_Needed := False;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 60c2ce034ea..1d3ab7d80df 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -2502,47 +2502,9 @@ package body Exp_Ch6 is
          end if;
       end New_Value;
 
-      function Rewritten_For_C_Func_Id (Proc_Id : Entity_Id) return Entity_Id;
-      --  Given the Id of the procedure with an extra out parameter internally
-      --  built to handle functions that return a constrained array type return
-      --  the Id of the corresponding function.
-
-      -----------------------------
-      -- Rewritten_For_C_Func_Id --
-      -----------------------------
-
-      function Rewritten_For_C_Func_Id (Proc_Id : Entity_Id) return Entity_Id
-      is
-         Decl      : constant Node_Id := Unit_Declaration_Node (Proc_Id);
-         Func_Decl : Node_Id;
-         Func_Id   : Entity_Id;
-
-      begin
-         pragma Assert (Rewritten_For_C (Proc_Id));
-         pragma Assert (Nkind (Decl) = N_Subprogram_Body);
-
-         Func_Decl := Nlists.Prev (Decl);
-
-         while Present (Func_Decl)
-           and then
-             (Nkind (Func_Decl) = N_Freeze_Entity
-                or else
-              Nkind (Func_Decl) /= N_Subprogram_Declaration
-                or else
-              Nkind (Specification (Func_Decl)) /= N_Function_Specification)
-         loop
-            Func_Decl := Nlists.Prev (Func_Decl);
-         end loop;
-
-         pragma Assert (Present (Func_Decl));
-         Func_Id := Defining_Entity (Specification (Func_Decl));
-         pragma Assert (Chars (Proc_Id) = Chars (Func_Id));
-         return Func_Id;
-      end Rewritten_For_C_Func_Id;
-
       --  Local variables
 
-      Remote        : constant Boolean   := Is_Remote_Call (Call_Node);
+      Remote        : constant Boolean := Is_Remote_Call (Call_Node);
       Actual        : Node_Id;
       Formal        : Entity_Id;
       Orig_Subp     : Entity_Id := Empty;
@@ -2706,8 +2668,9 @@ package body Exp_Ch6 is
                               N_Subprogram_Body
          then
             Set_Entity (Name (Call_Node),
-              Rewritten_For_C_Func_Id
-                (Ultimate_Alias (Entity (Name (Call_Node)))));
+              Corresponding_Function
+                (Corresponding_Procedure
+                  (Ultimate_Alias (Entity (Name (Call_Node))))));
          end if;
 
          Rewrite_Function_Call_For_C (Call_Node);
@@ -8405,45 +8368,10 @@ package body Exp_Ch6 is
    ---------------------------------
 
    procedure Rewrite_Function_Call_For_C (N : Node_Id) is
-      function Rewritten_For_C_Proc_Id (Func_Id : Entity_Id) return Entity_Id;
-      --  Given the Id of the function that returns a constrained array type
-      --  return the Id of its internally built procedure with an extra out
-      --  parameter.
-
-      -----------------------------
-      -- Rewritten_For_C_Proc_Id --
-      -----------------------------
-
-      function Rewritten_For_C_Proc_Id (Func_Id : Entity_Id) return Entity_Id
-      is
-         Func_Decl : constant Node_Id := Unit_Declaration_Node (Func_Id);
-         Proc_Decl : Node_Id;
-         Proc_Id   : Entity_Id;
-
-      begin
-         Proc_Decl := Next (Func_Decl);
-
-         while Present (Proc_Decl)
-           and then
-             (Nkind (Proc_Decl) = N_Freeze_Entity
-                or else
-              Nkind (Proc_Decl) /= N_Subprogram_Declaration)
-         loop
-            Proc_Decl := Next (Proc_Decl);
-         end loop;
-
-         pragma Assert (Present (Proc_Decl));
-         Proc_Id := Defining_Entity (Proc_Decl);
-         pragma Assert (Chars (Proc_Id) = Chars (Func_Id));
-         return Proc_Id;
-      end Rewritten_For_C_Proc_Id;
-
-      --  Local variables
-
       Orig_Func   : constant Entity_Id  := Entity (Name (N));
       Func_Id     : constant Entity_Id  := Ultimate_Alias (Orig_Func);
       Par         : constant Node_Id    := Parent (N);
-      Proc_Id     : constant Entity_Id  := Rewritten_For_C_Proc_Id (Func_Id);
+      Proc_Id     : constant Entity_Id  := Corresponding_Procedure (Func_Id);
       Loc         : constant Source_Ptr := Sloc (Par);
       Actuals     : List_Id;
       Last_Actual : Node_Id;
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index d1475e7d1ea..302cc100834 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -507,7 +507,7 @@ package body Exp_Unst is
 
                elsif Ekind (Callee) = E_Function
                  and then Rewritten_For_C (Callee)
-                 and then Next_Entity (Callee) = Caller
+                 and then Corresponding_Procedure (Callee) = Caller
                then
                   return;
                end if;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 7591c3afd27..fe0f5882f79 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -996,9 +996,12 @@ package body Exp_Util is
 
       Set_Is_Immediately_Visible (Defining_Entity (Proc_Decl), False);
 
-      --  Mark the function as having a procedure form
+      --  Mark the function as having a procedure form and link the function
+      --  and its internally built procedure.
 
       Set_Rewritten_For_C (Subp);
+      Set_Corresponding_Procedure (Subp, Defining_Entity (Proc_Decl));
+      Set_Corresponding_Function (Defining_Entity (Proc_Decl), Subp);
    end Build_Procedure_Form;
 
    ------------------------
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 25022e95a9e..575a1d2ea3c 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2052,6 +2052,13 @@ package body Sem_Aggr is
                      Set_Parent (Expr, Parent (Expression (Assoc)));
                      Analyze (Expr);
 
+                     --  Compute its dimensions now, rather than at the end
+                     --  of resolution, because in the case of multidimensional
+                     --  aggregates subsequent expansion may lead to spurious
+                     --  errors.
+
+                     Check_Expression_Dimensions (Expr, Component_Typ);
+
                      --  If the expression is a literal, propagate this info
                      --  to the expression in the association, to enable some
                      --  optimizations downstream.
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a6f22b1744b..726c20ff3e8 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2405,14 +2405,20 @@ package body Sem_Ch6 is
 
          Analyze (Subp_Decl);
 
-         --  Propagate the attribute Rewritten_For_C to the body since the
-         --  expander may generate calls using that entity. Required to ensure
-         --  that Expand_Call rewrites calls to this function by calls to the
-         --  built procedure.
+         --  Propagate the attributes Rewritten_For_C and Corresponding_Proc to
+         --  the body since the expander may generate calls using that entity.
+         --  Required to ensure that Expand_Call rewrites calls to this
+         --  function by calls to the built procedure.
 
-         if Nkind (Body_Spec) = N_Function_Specification then
-            Set_Rewritten_For_C (Defining_Entity (Body_Spec),
-              Rewritten_For_C (Defining_Entity (Specification (Subp_Decl))));
+         if Modify_Tree_For_C
+           and then Nkind (Body_Spec) = N_Function_Specification
+           and then
+              Rewritten_For_C (Defining_Entity (Specification (Subp_Decl)))
+         then
+            Set_Rewritten_For_C (Defining_Entity (Body_Spec));
+            Set_Corresponding_Procedure (Defining_Entity (Body_Spec),
+              Corresponding_Procedure
+                (Defining_Entity (Specification (Subp_Decl))));
          end if;
 
          --  Analyze any relocated source pragmas or pragmas created for aspect
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 50676987367..754be84ab0d 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2011-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1235,10 +1235,12 @@ package body Sem_Dim is
          --  since it may not be decorated at this point. We also don't want to
          --  issue the same error message multiple times on the same expression
          --  (may happen when an aggregate is converted into a positional
-         --  aggregate).
+         --  aggregate). We also must verify that this is a scalar component,
+         --  and not a subaggregate of a multidimensional aggregate.
 
          if Comes_From_Source (Original_Node (Expr))
            and then Present (Etype (Expr))
+           and then Is_Numeric_Type (Etype (Expr))
            and then Dimensions_Of (Expr) /= Dims_Of_Comp_Typ
            and then Sloc (Comp) /= Sloc (Prev (Comp))
          then
@@ -2270,6 +2272,27 @@ package body Sem_Dim is
       end case;
    end Analyze_Dimension_Unary_Op;
 
+   ---------------------------------
+   -- Check_Expression_Dimensions --
+   ---------------------------------
+
+   procedure Check_Expression_Dimensions
+      (Expr : Node_Id;
+       Typ  : Entity_Id)
+   is
+   begin
+      if Is_Floating_Point_Type (Etype (Expr)) then
+         Analyze_Dimension (Expr);
+
+         if Dimensions_Of (Expr) /= Dimensions_Of (Typ) then
+            Error_Msg_N ("dimensions mismatch in array aggregate", Expr);
+            Error_Msg_N
+              ("\expected dimension " & Dimensions_Msg_Of (Typ)
+               & ", found " & Dimensions_Msg_Of (Expr), Expr);
+         end if;
+      end if;
+   end Check_Expression_Dimensions;
+
    ---------------------
    -- Copy_Dimensions --
    ---------------------
diff --git a/gcc/ada/sem_dim.ads b/gcc/ada/sem_dim.ads
index d1521e90826..bce497a5850 100644
--- a/gcc/ada/sem_dim.ads
+++ b/gcc/ada/sem_dim.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2011-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -164,6 +164,16 @@ package Sem_Dim is
    --  For sub spec N, issue a warning for each dimensioned formal with a
    --  literal default value in the list of formals Formals.
 
+   procedure Check_Expression_Dimensions
+      (Expr : Node_Id;
+       Typ  : Entity_Id);
+   --  Compute dimensions of a floating-point expression and compare them
+   --  with the dimensions of a the given type. Used to verify dimensions
+   --  of the components of a multidimensional array type, for which components
+   --  are typically themselves arrays. The resolution of such arrays delays
+   --  the resolution of the ultimate components to a separate phase, which
+   --  forces this separate dimension verification.
+
    procedure Copy_Dimensions (From, To : Node_Id);
    --  Copy dimension vector of node From to node To. Note that To must be a
    --  node that is allowed to contain a dimension (see OK_For_Dimension in
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c6effa379de..57a7fc9e539 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3107,6 +3107,10 @@ package body Sem_Res is
       --  interpretation, but the form of the actual can only be determined
       --  once the primitive operation is identified.
 
+      procedure Flag_Effectively_Volatile_Objects (Expr : Node_Id);
+      --  Emit an error concerning the illegal usage of an effectively volatile
+      --  object in interfering context (SPARK RM 7.13(12)).
+
       procedure Insert_Default;
       --  If the actual is missing in a call, insert in the actuals list
       --  an instance of the default expression. The insertion is always
@@ -3360,6 +3364,55 @@ package body Sem_Res is
          end if;
       end Check_Prefixed_Call;
 
+      ---------------------------------------
+      -- Flag_Effectively_Volatile_Objects --
+      ---------------------------------------
+
+      procedure Flag_Effectively_Volatile_Objects (Expr : Node_Id) is
+         function Flag_Object (N : Node_Id) return Traverse_Result;
+         --  Determine whether arbitrary node N denotes an effectively volatile
+         --  object and if it does, emit an error.
+
+         -----------------
+         -- Flag_Object --
+         -----------------
+
+         function Flag_Object (N : Node_Id) return Traverse_Result is
+            Id : Entity_Id;
+
+         begin
+            --  Do not consider nested function calls because they have already
+            --  been processed during their own resolution.
+
+            if Nkind (N) = N_Function_Call then
+               return Skip;
+
+            elsif Is_Entity_Name (N) and then Present (Entity (N)) then
+               Id := Entity (N);
+
+               if Is_Object (Id)
+                 and then Is_Effectively_Volatile (Id)
+                 and then (Async_Writers_Enabled (Id)
+                            or else Effective_Reads_Enabled (Id))
+               then
+                  Error_Msg_N
+                    ("volatile object cannot appear in this context (SPARK "
+                     & "RM 7.1.3(11))", N);
+                  return Skip;
+               end if;
+            end if;
+
+            return OK;
+         end Flag_Object;
+
+         procedure Flag_Objects is new Traverse_Proc (Flag_Object);
+
+      --  Start of processing for Flag_Effectively_Volatile_Objects
+
+      begin
+         Flag_Objects (Expr);
+      end Flag_Effectively_Volatile_Objects;
+
       --------------------
       -- Insert_Default --
       --------------------
@@ -3461,7 +3514,6 @@ package body Sem_Res is
             then
                Set_Is_Controlling_Actual (Actval);
             end if;
-
          end if;
 
          --  If the default expression raises constraint error, then just
@@ -4473,10 +4525,8 @@ package body Sem_Res is
             --  they are not standard Ada legality rule. Internally generated
             --  temporaries are ignored.
 
-            if SPARK_Mode = On
-              and then Comes_From_Source (A)
-              and then Is_Effectively_Volatile_Object (A)
-            then
+            if SPARK_Mode = On and then Comes_From_Source (A) then
+
                --  An effectively volatile object may act as an actual when the
                --  corresponding formal is of a non-scalar effectively volatile
                --  type (SPARK RM 7.1.3(11)).
@@ -4493,10 +4543,23 @@ package body Sem_Res is
                elsif Is_Unchecked_Conversion_Instance (Nam) then
                   null;
 
-               else
+               --  The actual denotes an object
+
+               elsif Is_Effectively_Volatile_Object (A) then
                   Error_Msg_N
                     ("volatile object cannot act as actual in a call (SPARK "
                      & "RM 7.1.3(11))", A);
+
+               --  Otherwise the actual denotes an expression. Inspect the
+               --  expression and flag each effectively volatile object with
+               --  enabled property Async_Writers or Effective_Reads as illegal
+               --  because it apprears within an interfering context. Note that
+               --  this is usually done in Resolve_Entity_Name, but when the
+               --  effectively volatile object appears as an actual in a call,
+               --  the call must be resolved first.
+
+               else
+                  Flag_Effectively_Volatile_Objects (A);
                end if;
 
                --  Detect an external variable with an enabled property that
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 46baf0bc882..b49c7888549 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -9314,7 +9314,7 @@ package body Sem_Util is
            Has_Default_Aspect (Typ)
              or else Has_Full_Default_Initialization (Component_Type (Typ));
 
-      --  A protected type, record type or type extension is fully default
+      --  A protected type, record type, or type extension is fully default
       --  initialized if all its components either carry an initialization
       --  expression or have a type that is fully default initialized. The
       --  parent type of a type extension must be fully default initialized.
@@ -13159,7 +13159,7 @@ package body Sem_Util is
             when N_Function_Call =>
                return Etype (N) /= Standard_Void_Type;
 
-            --  Attributes 'Input, 'Loop_Entry, 'Old and 'Result produce
+            --  Attributes 'Input, 'Loop_Entry, 'Old, and 'Result produce
             --  objects.
 
             when N_Attribute_Reference =>
@@ -13346,14 +13346,15 @@ package body Sem_Util is
    is
       function Is_Protected_Operation_Call (Nod : Node_Id) return Boolean;
       --  Determine whether an arbitrary node denotes a call to a protected
-      --  entry, function or procedure in prefixed form where the prefix is
+      --  entry, function, or procedure in prefixed form where the prefix is
       --  Obj_Ref.
 
       function Within_Check (Nod : Node_Id) return Boolean;
       --  Determine whether an arbitrary node appears in a check node
 
       function Within_Subprogram_Call (Nod : Node_Id) return Boolean;
-      --  Determine whether an arbitrary node appears in a procedure call
+      --  Determine whether an arbitrary node appears in an entry, function, or
+      --  procedure call.
 
       function Within_Volatile_Function (Id : Entity_Id) return Boolean;
       --  Determine whether an arbitrary entity appears in a volatile function
@@ -13405,7 +13406,7 @@ package body Sem_Util is
             if Nkind (Par) in N_Raise_xxx_Error then
                return True;
 
-               --  Prevent the search from going too far
+            --  Prevent the search from going too far
 
             elsif Is_Body_Or_Package_Declaration (Par) then
                exit;
@@ -13435,7 +13436,7 @@ package body Sem_Util is
             then
                return True;
 
-               --  Prevent the search from going too far
+            --  Prevent the search from going too far
 
             elsif Is_Body_Or_Package_Declaration (Par) then
                exit;
@@ -13481,8 +13482,8 @@ package body Sem_Util is
       if Nkind (Context) = N_Assignment_Statement then
          return True;
 
-         --  The volatile object is part of the initialization expression of
-         --  another object.
+      --  The volatile object is part of the initialization expression of
+      --  another object.
 
       elsif Nkind (Context) = N_Object_Declaration
         and then Present (Expression (Context))
@@ -13497,21 +13498,21 @@ package body Sem_Util is
          if Is_Return_Object (Obj_Id) then
             return Within_Volatile_Function (Obj_Id);
 
-            --  Otherwise this is a normal object initialization
+         --  Otherwise this is a normal object initialization
 
          else
             return True;
          end if;
 
-         --  The volatile object acts as the name of a renaming declaration
+      --  The volatile object acts as the name of a renaming declaration
 
       elsif Nkind (Context) = N_Object_Renaming_Declaration
         and then Name (Context) = Obj_Ref
       then
          return True;
 
-         --  The volatile object appears as an actual parameter in a call to an
-         --  instance of Unchecked_Conversion whose result is renamed.
+      --  The volatile object appears as an actual parameter in a call to an
+      --  instance of Unchecked_Conversion whose result is renamed.
 
       elsif Nkind (Context) = N_Function_Call
         and then Is_Entity_Name (Name (Context))
@@ -13520,14 +13521,14 @@ package body Sem_Util is
       then
          return True;
 
-         --  The volatile object is actually the prefix in a protected entry,
-         --  function, or procedure call.
+      --  The volatile object is actually the prefix in a protected entry,
+      --  function, or procedure call.
 
       elsif Is_Protected_Operation_Call (Context) then
          return True;
 
-         --  The volatile object appears as the expression of a simple return
-         --  statement that applies to a volatile function.
+      --  The volatile object appears as the expression of a simple return
+      --  statement that applies to a volatile function.
 
       elsif Nkind (Context) = N_Simple_Return_Statement
         and then Expression (Context) = Obj_Ref
@@ -13535,8 +13536,8 @@ package body Sem_Util is
          return
            Within_Volatile_Function (Return_Statement_Entity (Context));
 
-         --  The volatile object appears as the prefix of a name occurring in a
-         --  non-interfering context.
+      --  The volatile object appears as the prefix of a name occurring in a
+      --  non-interfering context.
 
       elsif Nkind_In (Context, N_Attribute_Reference,
                       N_Explicit_Dereference,
@@ -13550,8 +13551,8 @@ package body Sem_Util is
       then
          return True;
 
-         --  The volatile object appears as the expression of a type conversion
-         --  occurring in a non-interfering context.
+      --  The volatile object appears as the expression of a type conversion
+      --  occurring in a non-interfering context.
 
       elsif Nkind_In (Context, N_Type_Conversion,
                       N_Unchecked_Type_Conversion)
@@ -13562,21 +13563,22 @@ package body Sem_Util is
       then
          return True;
 
-         --  Allow references to volatile objects in various checks. This is
-         --  not a direct SPARK 2014 requirement.
+      --  Allow references to volatile objects in various checks. This is not a
+      --  direct SPARK 2014 requirement.
 
       elsif Within_Check (Context) then
          return True;
 
-         --  Assume that references to effectively volatile objects that appear
-         --  as actual parameters in a subprogram call are always legal. A full
-         --  legality check is done when the actuals are resolved.
+      --  Assume that references to effectively volatile objects that appear
+      --  as actual parameters in a subprogram call are always legal. A full
+      --  legality check is done when the actuals are resolved (see routine
+      --  Resolve_Actuals).
 
       elsif Within_Subprogram_Call (Context) then
          return True;
 
-         --  Otherwise the context is not suitable for an effectively volatile
-         --  object.
+      --  Otherwise the context is not suitable for an effectively volatile
+      --  object.
 
       else
          return False;
@@ -13888,7 +13890,7 @@ package body Sem_Util is
 
    begin
       --  Verify that prefix is analyzed and has the proper form. Note that
-      --  the attributes Elab_Spec, Elab_Body and Elab_Subp_Body which also
+      --  the attributes Elab_Spec, Elab_Body, and Elab_Subp_Body, which also
       --  produce the address of an entity, do not analyze their prefix
       --  because they denote entities that are not necessarily visible.
       --  Neither of them can apply to a protected type.
@@ -16034,7 +16036,7 @@ package body Sem_Util is
 
       procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id) is
       begin
-         --  Translate Next_Entity, Scope and Etype fields, in case they
+         --  Translate Next_Entity, Scope, and Etype fields, in case they
          --  reference entities that have been mapped into copies.
 
          Set_Next_Entity (New_Itype, Assoc (Next_Entity (New_Itype)));
@@ -19986,8 +19988,8 @@ package body Sem_Util is
          return False;
       end if;
 
-      --  Check that the size of the component is 8, 16, 32 or 64 bits and that
-      --  Typ is properly aligned.
+      --  Check that the size of the component is 8, 16, 32, or 64 bits and
+      --  that Typ is properly aligned.
 
       case Size is
          when 8 | 16 | 32 | 64 =>