diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 55 |
3 files changed, 61 insertions, 13 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d1e8fcfe0ea..f32cb22851c 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 5dcfbe86634..95e1f9a214a 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 476fe7da7c9..d342e347290 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); |