From e6b3f5ba80252a12abf02e5932300b11eb30d226 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 22 May 2015 13:17:54 +0000 Subject: [PATCH] sem_res.adb (Resolve_Actuals): If the call is to an overridden operation... 2015-05-22 Ed Schonberg * sem_res.adb (Resolve_Actuals): If the call is to an overridden operation, replace the names of the actuals in named associations with the names of the actuals of the subprogram that is eventually executed. The names of the formals and the defaults can differ between the two operations when they are operations of a formal derived type. From-SVN: r223569 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_res.adb | 44 ++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 49 insertions(+), 4 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 15dc2189fe7..8b3f99f2797 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2015-05-22 Ed Schonberg + + * sem_res.adb (Resolve_Actuals): If the call is to an overridden + operation, replace the names of the actuals in named associations + with the names of the actuals of the subprogram that is eventually + executed. The names of the formals and the defaults can differ + between the two operations when they are operations of a formal + derived type. + 2015-05-22 Bob Duff * a-convec.ads, a-convec.adb (Append): Check for fast path. Split diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b838e25b4cb..9d7ddf4fd32 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3050,6 +3050,14 @@ package body Sem_Res is F_Typ : Entity_Id; Prev : Node_Id := Empty; Orig_A : Node_Id; + Real_F : Entity_Id; + + Real_Subp : Entity_Id; + -- If the subprogram being called is an overridden operation, + -- Real_Subp is the subprogram that will be called. It may have + -- different formal names than the overridden operation, so after + -- actual is resolved, the name of the actual in a named association + -- must carry the name of the actual of the subprogram being called. procedure Check_Aliased_Parameter; -- Check rules on aliased parameters and related accessibility rules @@ -3560,12 +3568,27 @@ package body Sem_Res is Check_Argument_Order; Check_Function_Writable_Actuals (N); + if Is_Overloadable (Nam) + and then Is_Inherited_Operation (Nam) + and then Present (Alias (Nam)) + and then Present (Overridden_Operation (Alias (Nam))) + then + Real_Subp := Alias (Nam); + else + Real_Subp := Empty; + end if; + if Present (First_Actual (N)) then Check_Prefixed_Call; end if; A := First_Actual (N); F := First_Formal (Nam); + + if Present (Real_Subp) then + Real_F := First_Formal (Real_Subp); + end if; + while Present (F) loop if No (A) and then Needs_No_Actuals (Nam) then null; @@ -4400,10 +4423,19 @@ package body Sem_Res is and then not GNATprove_Mode then - Set_Entity (Selector_Name (Parent (A)), F); - Generate_Reference (F, Selector_Name (Parent (A))); - Set_Etype (Selector_Name (Parent (A)), F_Typ); - Generate_Reference (F_Typ, N, ' '); + -- If subprogram is overridden, use name of formal that + -- is being called. + + if Present (Real_Subp) then + Set_Entity (Selector_Name (Parent (A)), Real_F); + Set_Etype (Selector_Name (Parent (A)), Etype (Real_F)); + + else + Set_Entity (Selector_Name (Parent (A)), F); + Generate_Reference (F, Selector_Name (Parent (A))); + Set_Etype (Selector_Name (Parent (A)), F_Typ); + Generate_Reference (F_Typ, N, ' '); + end if; end if; Prev := A; @@ -4503,6 +4535,10 @@ package body Sem_Res is Next_Actual (A); + if Present (Real_Subp) then + Next_Formal (Real_F); + end if; + -- Case where actual is not present else -- 2.30.2