[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d1e8fcfe0eabeff6cbde3830280fb66dc748ce89..f32cb22851c74253c2e8d87452fa973edecbe998 100644 (file)
--- 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 5dcfbe8663424f559d19342e34164e4461084398..95e1f9a214a2b045e11e2ad5915dec56e18838a0 100644 (file)
--- 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 476fe7da7c9c73c3b898ae4ff0892fd37b721384..d342e347290e8706bc080de15cd9e5543b17f259 100644 (file)
--- 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);