From c386239f4dc9ba15abed10f87d5e775ca509a1bb Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 14:10:18 +0200 Subject: [PATCH] [multiple changes] 2015-10-20 Hristian Kirtchev * sem_util.adb (Find_Actual): The routine is now capable of operating on entry calls. 2015-10-20 Ed Schonberg * sem_res.adb: Remove redundant check. From-SVN: r229059 --- gcc/ada/ChangeLog | 9 +++++ gcc/ada/sem_res.adb | 5 ++- gcc/ada/sem_util.adb | 95 ++++++++++++++++++++++++++------------------ 3 files changed, 68 insertions(+), 41 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 65e6c4c932d..e6c099a997b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2015-10-20 Hristian Kirtchev + + * sem_util.adb (Find_Actual): The routine is + now capable of operating on entry calls. + +2015-10-20 Ed Schonberg + + * sem_res.adb: Remove redundant check. + 2015-10-20 Jerome Lambourg * init.c (__gnat_vxsim_error_handler): Completely disable on diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 7ff465a805b..479b5c50e03 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9877,10 +9877,11 @@ package body Sem_Res is T := Etype (P); end if; - -- Set flag for expander if discriminant check required + -- Set flag for expander if discriminant check required on a component + -- appearing within a variant. if Has_Discriminants (T) - and then Ekind_In (Entity (S), E_Component, E_Discriminant) + and then Ekind (Entity (S)) = E_Component and then Present (Original_Record_Component (Entity (S))) and then Ekind (Original_Record_Component (Entity (S))) = E_Component and then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b2f1f103a1e..8f93bcdb32e 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6557,23 +6557,27 @@ package body Sem_Util is Formal : out Entity_Id; Call : out Node_Id) is - Parnt : constant Node_Id := Parent (N); - Actual : Node_Id; + Context : constant Node_Id := Parent (N); + Actual : Node_Id; + Call_Nam : Node_Id; begin - if Nkind_In (Parnt, N_Indexed_Component, N_Selected_Component) - and then N = Prefix (Parnt) + if Nkind_In (Context, N_Indexed_Component, N_Selected_Component) + and then N = Prefix (Context) then - Find_Actual (Parnt, Formal, Call); + Find_Actual (Context, Formal, Call); return; - elsif Nkind (Parnt) = N_Parameter_Association - and then N = Explicit_Actual_Parameter (Parnt) + elsif Nkind (Context) = N_Parameter_Association + and then N = Explicit_Actual_Parameter (Context) then - Call := Parent (Parnt); + Call := Parent (Context); - elsif Nkind (Parnt) in N_Subprogram_Call then - Call := Parnt; + elsif Nkind_In (Context, N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement) + then + Call := Context; else Formal := Empty; @@ -6585,44 +6589,57 @@ package body Sem_Util is -- we exclude overloaded calls, since we don't know enough to be sure -- of giving the right answer in this case. - if Nkind_In (Call, N_Function_Call, N_Procedure_Call_Statement) - and then Is_Entity_Name (Name (Call)) - and then Present (Entity (Name (Call))) - and then Is_Overloadable (Entity (Name (Call))) - and then not Is_Overloaded (Name (Call)) + if Nkind_In (Call, N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement) then - -- If node is name in call it is not an actual + Call_Nam := Name (Call); - if N = Name (Call) then - Call := Empty; - Formal := Empty; - return; + -- A call to a protected or task entry appears as a selected + -- component rather than an expanded name. + + if Nkind (Call_Nam) = N_Selected_Component then + Call_Nam := Selector_Name (Call_Nam); end if; - -- Fall here if we are definitely a parameter + if Is_Entity_Name (Call_Nam) + and then Present (Entity (Call_Nam)) + and then Is_Overloadable (Entity (Call_Nam)) + and then not Is_Overloaded (Call_Nam) + then + -- If node is name in call it is not an actual - Actual := First_Actual (Call); - Formal := First_Formal (Entity (Name (Call))); - while Present (Formal) and then Present (Actual) loop - if Actual = N then + if N = Call_Nam then + Formal := Empty; + Call := Empty; return; + end if; - -- An actual that is the prefix in a prefixed call may have - -- been rewritten in the call, after the deferred reference - -- was collected. Check if sloc and kinds and names match. + -- Fall here if we are definitely a parameter - elsif Sloc (Actual) = Sloc (N) - and then Nkind (Actual) = N_Identifier - and then Nkind (Actual) = Nkind (N) - and then Chars (Actual) = Chars (N) - then - return; + Actual := First_Actual (Call); + Formal := First_Formal (Entity (Call_Nam)); + while Present (Formal) and then Present (Actual) loop + if Actual = N then + return; - else - Actual := Next_Actual (Actual); - Formal := Next_Formal (Formal); - end if; - end loop; + -- An actual that is the prefix in a prefixed call may have + -- been rewritten in the call, after the deferred reference + -- was collected. Check if sloc and kinds and names match. + + elsif Sloc (Actual) = Sloc (N) + and then Nkind (Actual) = N_Identifier + and then Nkind (Actual) = Nkind (N) + and then Chars (Actual) = Chars (N) + then + return; + + else + Actual := Next_Actual (Actual); + Formal := Next_Formal (Formal); + end if; + end loop; + end if; end if; -- Fall through here if we did not find matching actual -- 2.30.2