[multiple changes]

2014-01-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Check_Function_Writable_Actuals): 1) Do not
	examine code that does not come from source. The check does not
	apply to code generated for constraint checks, and such code may
	generate spurious error messages when compiled with expansion
	disabled (as in a generic unit) because side effects may not
	have been removed.
	2) Make error messages more explicit: indicate the component
	of the	construct whose value is indeterminate because of a
	call to a function with in-out parameter in another component,
	when there is no mandated order of execution between the two
	components (actuals, aggregate components, alternatives).

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

	* gnat_rm.texi: Minor cleanup.

From-SVN: r206820

3 files changed, 61 insertions, 13 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d1e8fcf..f32cb22 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2014-01-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb (Check_Function_Writable_Actuals): 1) Do not
+	examine code that does not come from source. The check does not
+	apply to code generated for constraint checks, and such code may
+	generate spurious error messages when compiled with expansion
+	disabled (as in a generic unit) because side effects may not
+	have been removed.
+	2) Make error messages more explicit: indicate the component
+	of the	construct whose value is indeterminate because of a
+	call to a function with in-out parameter in another component,
+	when there is no mandated order of execution between the two
+	components (actuals, aggregate components, alternatives).
+
+2014-01-20  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Minor cleanup.
+
 2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_attr.adb (Analyze_Attribute): Attributes 'Old and 'Result
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5dcfbe8..95e1f9a 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1390,7 +1390,6 @@ ID_ASSERTION_KIND ::= Assertions           |
                       Precondition         |
                       Predicate            |
                       Refined_Post         |
-                      Refined_Pre          |
                       Statement_Assertions
 
 POLICY_IDENTIFIER ::= Check | Disable | Ignore
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 476fe7d..d342e34 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1525,6 +1525,7 @@ package body Sem_Util is
 
          function Check_Node (N : Node_Id) return Traverse_Result is
             Is_Writable_Actual : Boolean := False;
+            Id                 : Entity_Id;
 
          begin
             if Nkind (N) = N_Identifier then
@@ -1548,11 +1549,12 @@ package body Sem_Util is
                elsif Nkind (Parent (N)) = N_Function_Call then
                   declare
                      Call   : constant Node_Id   := Parent (N);
-                     Id     : constant Entity_Id := Get_Function_Id (Call);
                      Actual : Node_Id;
                      Formal : Node_Id;
 
                   begin
+                     Id := Get_Function_Id (Call);
+
                      Formal := First_Formal (Id);
                      Actual := First_Actual (Call);
                      while Present (Actual) and then Present (Formal) loop
@@ -1574,9 +1576,9 @@ package body Sem_Util is
 
                if Is_Writable_Actual then
                   if Contains (Writable_Actuals_List, N) then
-                     Error_Msg_N
-                       ("conflict of writable function parameter in "
-                        & "construct with arbitrary order of evaluation", N);
+                     Error_Msg_NE
+                       ("value may be affected by call to& "
+                        & "because order of evaluation is arbitrary", N, Id);
                      Error_Node := N;
                      return Abandon;
                   end if;
@@ -1691,6 +1693,10 @@ 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.
+
       if Ada_Version < Ada_2012
         or else (not (Nkind (N) in N_Op)
                   and then not (Nkind (N) in N_Membership_Test)
@@ -1702,7 +1708,12 @@ package body Sem_Util is
                                             N_Procedure_Call_Statement,
                                             N_Entry_Call_Statement))
         or else (Nkind (N) = N_Full_Type_Declaration
-                   and then not Is_Record_Type (Defining_Identifier (N)))
+                  and then not Is_Record_Type (Defining_Identifier (N)))
+
+        --  In addition, this check only applies to source code, not to code
+        --  generated by constraint checks.
+
+        or else not Comes_From_Source (N)
       then
          return;
       end if;
@@ -1947,9 +1958,9 @@ package body Sem_Util is
                               --  report occurrences of this case as warnings.
 
                               Error_Msg_N
-                                ("conflict of writable function parameter in "
-                                 & "construct with arbitrary order of "
-                                 & "evaluation?",
+                                ("writable function parameter may affect "
+                                 & "value in other component because order "
+                                 & "of evaluation is unspecified?",
                                  Node (First_Elmt (Writable_Actuals_List)));
                            end if;
                         end if;
@@ -2049,10 +2060,30 @@ package body Sem_Util is
                Elmt_2 := First_Elmt (Identifiers_List);
                while Present (Elmt_2) loop
                   if Entity (Node (Elmt_1)) = Entity (Node (Elmt_2)) then
-                     Error_Msg_N
-                       ("conflict of writable function parameter in construct "
-                        & "with arbitrary order of evaluation",
-                        Node (Elmt_1));
+                     case Nkind (Parent (Node (Elmt_2))) is
+                        when N_Aggregate             |
+                             N_Component_Association |
+                             N_Component_Declaration =>
+                           Error_Msg_N
+                             ("value may be affected by call in other "
+                              & "component because they are evaluated "
+                              & "in unspecified order",
+                              Node (Elmt_2));
+
+                        when N_In | N_Not_In =>
+                           Error_Msg_N
+                             ("value may be affected by call in other "
+                              & "alternative because they are evaluated "
+                              & "in unspecified order",
+                              Node (Elmt_2));
+
+                        when others =>
+                           Error_Msg_N
+                             ("value of actual may be affected by call in "
+                              & "other actual because they are evaluated "
+                              & "in unspecified order",
+                           Node (Elmt_2));
+                     end case;
                   end if;
 
                   Next_Elmt (Elmt_2);