From 0969e96dcb682892a69c2ef26135dbfd79da5d1b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 20 Jan 2014 16:19:15 +0100 Subject: [PATCH] [multiple changes] 2014-01-20 Ed Schonberg * 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 * gnat_rm.texi: Minor cleanup. From-SVN: r206820 --- gcc/ada/ChangeLog | 18 +++++++++++++++++ gcc/ada/gnat_rm.texi | 1 - gcc/ada/sem_util.adb | 55 ++++++++++++++++++++++++++++++++++++++++------------ 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 + + * 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 + + * gnat_rm.texi: Minor cleanup. + 2014-01-20 Hristian Kirtchev * 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); -- 2.7.4