[multiple changes]

2014-11-20  Robert Dewar  <dewar@adacore.com>

	* gnatcmd.adb, sem_ch6.adb, exp_dist.adb: Minor reformatting.
	* sem_util.adb (Bad_Unordered_Enumeration_Reference): Suppress
	warning (return False) for generic type.

2014-11-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Appears_In_Check): Removed.
	(Is_OK_Volatile_Context): Rewrite the checks which verify that
	an effectively volatile object subject to enabled properties
	Async_Writers or Effective_Reads appears in a suitable context to
	properly recognize a procedure call.
	(Within_Check): New routine.
	(Within_Procedure_Call): New routine.

From-SVN: r217848

1 files changed, 72 insertions, 37 deletions

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 90311ca..e0b1b0e 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6897,9 +6897,6 @@ package body Sem_Res is
    --  Used to resolve identifiers and expanded names
 
    procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id) is
-      function Appears_In_Check (Nod : Node_Id) return Boolean;
-      --  Denote whether an arbitrary node Nod appears in a check node
-
       function Is_OK_Volatile_Context
         (Context : Node_Id;
          Obj_Ref : Node_Id) return Boolean;
@@ -6907,41 +6904,76 @@ package body Sem_Res is
       --  (as defined in SPARK RM 7.1.3(13)) where volatile reference Obj_Ref
       --  can safely reside.
 
-      ----------------------
-      -- Appears_In_Check --
-      ----------------------
+      ----------------------------
+      -- Is_OK_Volatile_Context --
+      ----------------------------
 
-      function Appears_In_Check (Nod : Node_Id) return Boolean is
-         Par : Node_Id;
+      function Is_OK_Volatile_Context
+        (Context : Node_Id;
+         Obj_Ref : Node_Id) return Boolean
+      is
+         function Within_Check (Nod : Node_Id) return Boolean;
+         --  Determine whether an arbitrary node appears in a check node
 
-      begin
-         --  Climb the parent chain looking for a check node
+         function Within_Procedure_Call (Nod : Node_Id) return Boolean;
+         --  Determine whether an arbitrary node appears in a procedure call
 
-         Par := Nod;
-         while Present (Par) loop
-            if Nkind (Par) in N_Raise_xxx_Error then
-               return True;
+         ------------------
+         -- Within_Check --
+         ------------------
 
-            --  Prevent the search from going too far
+         function Within_Check (Nod : Node_Id) return Boolean is
+            Par : Node_Id;
 
-            elsif Is_Body_Or_Package_Declaration (Par) then
-               exit;
-            end if;
+         begin
+            --  Climb the parent chain looking for a check node
 
-            Par := Parent (Par);
-         end loop;
+            Par := Nod;
+            while Present (Par) loop
+               if Nkind (Par) in N_Raise_xxx_Error then
+                  return True;
 
-         return False;
-      end Appears_In_Check;
+               --  Prevent the search from going too far
 
-      ----------------------------
-      -- Is_OK_Volatile_Context --
-      ----------------------------
+               elsif Is_Body_Or_Package_Declaration (Par) then
+                  exit;
+               end if;
+
+               Par := Parent (Par);
+            end loop;
+
+            return False;
+         end Within_Check;
+
+         ---------------------------
+         -- Within_Procedure_Call --
+         ---------------------------
+
+         function Within_Procedure_Call (Nod : Node_Id) return Boolean is
+            Par : Node_Id;
+
+         begin
+            --  Climb the parent chain looking for a procedure call
+
+            Par := Nod;
+            while Present (Par) loop
+               if Nkind (Par) = N_Procedure_Call_Statement then
+                  return True;
+
+               --  Prevent the search from going too far
+
+               elsif Is_Body_Or_Package_Declaration (Par) then
+                  exit;
+               end if;
+
+               Par := Parent (Par);
+            end loop;
+
+            return False;
+         end Within_Procedure_Call;
+
+      --  Start of processing for Is_OK_Volatile_Context
 
-      function Is_OK_Volatile_Context
-        (Context : Node_Id;
-         Obj_Ref : Node_Id) return Boolean
-      is
       begin
          --  The volatile object appears on either side of an assignment
 
@@ -6996,9 +7028,19 @@ package body Sem_Res is
          --  Allow references to volatile objects in various checks. This is
          --  not a direct SPARK 2014 requirement.
 
-         elsif Appears_In_Check (Context) then
+         elsif Within_Check (Context) then
+            return True;
+
+         --  Assume that references to effectively volatile objects that appear
+         --  as actual parameters in a procedure call are always legal. A full
+         --  legality check is done when the actuals are resolved.
+
+         elsif Within_Procedure_Call (Context) then
             return True;
 
+         --  Otherwise the context is not suitable for an effectively volatile
+         --  object.
+
          else
             return False;
          end if;
@@ -7140,13 +7182,6 @@ package body Sem_Res is
          if Is_OK_Volatile_Context (Par, N) then
             null;
 
-         --  Assume that references to effectively volatile objects that appear
-         --  as actual parameters in a procedure call are always legal. A full
-         --  legality check is done when the actuals are resolved.
-
-         elsif Nkind (Par) = N_Procedure_Call_Statement then
-            null;
-
          --  Otherwise the context causes a side effect with respect to the
          --  effectively volatile object.