diff mbox

[Ada] Handling of overloaded indexing functions

Message ID 20151113131458.GA20127@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Nov. 13, 2015, 1:14 p.m. UTC 
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  <schonberg@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.
diff mbox

Patch

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);