mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 17:40:48 +08:00
Code Issues Packages Projects Releases Wiki Activity

sem_res.adb (Resolve_Actuals): If the call is to an overridden operation...

Browse Source 
2015-05-22  Ed Schonberg  <schonberg@adacore.com>

	* 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
This commit is contained in:
Ed Schonberg 2015-05-22 13:17:54 +00:00 committed by Arnaud Charlet
parent d992a425b7
commit e6b3f5ba80
2 changed files with 49 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/ada/ChangeLog
View File

@ -1,3 +1,12 @@
2015-05-22 Ed Schonberg <schonberg@adacore.com>
* 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 <duff@adacore.com>
* a-convec.ads, a-convec.adb (Append): Check for fast path. Split

44
gcc/ada/sem_res.adb
View File

@ -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