This patch completes the handling of generalized indexing in the presence of
multiple indexing functions, when a derived type overrides inherited ones
and defines new constant and variable indexing functions.
Test in ACATS 4.0F C416A02
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-11-13 Ed Schonberg <schonb...@adacore.com>
* sem_ch4.adb (Indicate_Name_And_Type): If the analysis of
one interpretation succeeds, set type of name in call, for
completeness.
(Try_Container_Indexing): If there are multiple indexing
functions, collect possible interpretations that are compatible
with given parameters, and add implicit dereference types when
present.
* sem_util.adb (Build_Explicit_Dereference): If the expression
is an overloaded function call use the given discriminant to
resolve the call, and set properly the type of the call and of
the resulting dereference.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 230305)
+++ sem_util.adb (working copy)
@@ -1732,6 +1732,8 @@
Disc : Entity_Id)
is
Loc : constant Source_Ptr := Sloc (Expr);
+ I : Interp_Index;
+ It : Interp;
begin
-- An entity of a type with a reference aspect is overloaded with
@@ -1744,6 +1746,29 @@
Set_Etype (Expr, Etype (Entity (Expr)));
elsif Nkind (Expr) = N_Function_Call then
+
+ -- If the name of the indexing function is overloaded, locate the one
+ -- whose return type has an implicit dereference on the desired
+ -- discriminant, and set entity and type of function call.
+
+ if Is_Overloaded (Name (Expr)) then
+ Get_First_Interp (Name (Expr), I, It);
+
+ while Present (It.Nam) loop
+ if Ekind ((It.Typ)) = E_Record_Type
+ and then First_Entity ((It.Typ)) = Disc
+ then
+ Set_Entity (Name (Expr), It.Nam);
+ Set_Etype (Name (Expr), Etype (It.Nam));
+ exit;
+ end if;
+
+ Get_Next_Interp (I, It);
+ end loop;
+ end if;
+
+ -- Set type of call from resolved function name.
+
Set_Etype (Expr, Etype (Name (Expr)));
end if;
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 230314)
+++ sem_ch4.adb (working copy)
@@ -3073,6 +3073,7 @@
if not Is_Type (Nam) then
if Is_Entity_Name (Name (N)) then
Set_Entity (Name (N), Nam);
+ Set_Etype (Name (N), Etype (Nam));
elsif Nkind (Name (N)) = N_Selected_Component then
Set_Entity (Selector_Name (Name (N)), Nam);
@@ -7456,6 +7457,9 @@
end if;
else
+ -- If there are multiple indexing functions, build a function call
+ -- and analyze it for each of the possible interpretations.
+
Indexing :=
Make_Function_Call (Loc,
Name =>
@@ -7464,6 +7468,8 @@
Set_Parent (Indexing, Parent (N));
Set_Generalized_Indexing (N, Indexing);
+ Set_Etype (N, Any_Type);
+ Set_Etype (Name (Indexing), Any_Type);
declare
I : Interp_Index;
@@ -7473,21 +7479,24 @@
begin
Get_First_Interp (Func_Name, I, It);
Set_Etype (Indexing, Any_Type);
+
while Present (It.Nam) loop
Analyze_One_Call (Indexing, It.Nam, False, Success);
if Success then
- Set_Etype (Name (Indexing), It.Typ);
- Set_Entity (Name (Indexing), It.Nam);
- Set_Etype (N, Etype (Indexing));
- -- Add implicit dereference interpretation
+ -- Function in current interpretation is a valid candidate.
+ -- Its result type is also a potential type for the
+ -- original Indexed_Component node.
+ Add_One_Interp (Name (Indexing), It.Nam, It.Typ);
+ Add_One_Interp (N, It.Nam, It.Typ);
+
+ -- Add implicit dereference interpretation to original node
+
if Has_Discriminants (Etype (It.Nam)) then
Check_Implicit_Dereference (N, Etype (It.Nam));
end if;
-
- exit;
end if;
Get_Next_Interp (I, It);
