Next_Actual (Actual);
Next_Formal (Formal);
- -- In a complex case where an enclosing generic and a nested
- -- generic package, both declared with partially parameterized
- -- formal subprograms with the same names, are instantiated
- -- with the same type, the types of the actual parameter and
- -- that of the formal may appear incompatible at first sight.
-
- -- generic
- -- type Outer_T is private;
- -- with function Func (Formal : Outer_T)
- -- return ... is <>;
-
- -- package Outer_Gen is
- -- generic
- -- type Inner_T is private;
- -- with function Func (Formal : Inner_T) -- (1)
- -- return ... is <>;
-
- -- package Inner_Gen is
- -- function Inner_Func (Formal : Inner_T) -- (2)
- -- return ... is (Func (Formal));
- -- end Inner_Gen;
- -- end Outer_Generic;
-
- -- package Outer_Inst is new Outer_Gen (Actual_T);
- -- package Inner_Inst is new Outer_Inst.Inner_Gen (Actual_T);
-
- -- In the example above, the type of parameter
- -- Inner_Func.Formal at (2) is incompatible with the type of
- -- Func.Formal at (1) in the context of instantiations
- -- Outer_Inst and Inner_Inst. In reality both types are generic
- -- actual subtypes renaming base type Actual_T as part of the
- -- generic prologues for the instantiations.
-
- -- Recognize this case and add a type conversion to allow this
- -- kind of generic actual subtype conformance. Note that this
- -- is done only when the call is non-overloaded because the
- -- resolution mechanism already has the means to disambiguate
- -- similar cases.
-
- elsif not Is_Overloaded (Name (N))
- and then Is_Type (Etype (Actual))
- and then Is_Type (Etype (Formal))
- and then Is_Generic_Actual_Type (Etype (Actual))
- and then Is_Generic_Actual_Type (Etype (Formal))
- and then Base_Type (Etype (Actual)) =
- Base_Type (Etype (Formal))
- then
- Rewrite (Actual,
- Convert_To (Etype (Formal), Relocate_Node (Actual)));
- Analyze_And_Resolve (Actual, Etype (Formal));
- Next_Actual (Actual);
- Next_Formal (Formal);
-
-- Handle failed type check
else
Old_S : Entity_Id;
Inst : Entity_Id;
+ function Find_Nearer_Entity
+ (New_S : Entity_Id;
+ Old1_S : Entity_Id;
+ Old2_S : Entity_Id) return Entity_Id;
+ -- Determine whether one of Old_S1 and Old_S2 is nearer to New_S than
+ -- the other, and return it if so. Return Empty otherwise. We use this
+ -- in conjunction with Inherit_Renamed_Profile to simplify later type
+ -- disambiguation for actual subprograms in instances.
+
function Is_Visible_Operation (Op : Entity_Id) return Boolean;
-- If the renamed entity is an implicit operator, check whether it is
-- visible because its operand type is properly visible. This check
-- Determine whether a candidate subprogram is defined within the
-- enclosing instance. If yes, it has precedence over outer candidates.
+ --------------------------
+ -- Find_Nearer_Entity --
+ --------------------------
+
+ function Find_Nearer_Entity
+ (New_S : Entity_Id;
+ Old1_S : Entity_Id;
+ Old2_S : Entity_Id) return Entity_Id
+ is
+ New_F : Entity_Id;
+ Old1_F : Entity_Id;
+ Old2_F : Entity_Id;
+ Anc_T : Entity_Id;
+
+ begin
+ New_F := First_Formal (New_S);
+ Old1_F := First_Formal (Old1_S);
+ Old2_F := First_Formal (Old2_S);
+
+ -- The criterion is whether the type of the formals of one of Old1_S
+ -- and Old2_S is an ancestor subtype of the type of the corresponding
+ -- formals of New_S while the other is not (we already know that they
+ -- are all subtypes of the same base type).
+
+ -- This makes it possible to find the more correct renamed entity in
+ -- the case of a generic instantiation nested in an enclosing one for
+ -- which different formal types get the same actual type, which will
+ -- in turn make it possible for Inherit_Renamed_Profile to preserve
+ -- types on formal parameters and ultimately simplify disambiguation.
+
+ -- Consider the follow package G:
+
+ -- generic
+ -- type Item_T is private;
+ -- with function Compare (L, R: Item_T) return Boolean is <>;
+
+ -- type Bound_T is private;
+ -- with function Compare (L, R : Bound_T) return Boolean is <>;
+ -- package G is
+ -- ...
+ -- end G;
+
+ -- package body G is
+ -- package My_Inner is Inner_G (Bound_T);
+ -- ...
+ -- end G;
+
+ -- with the following package Inner_G:
+
+ -- generic
+ -- type T is private;
+ -- with function Compare (L, R: T) return Boolean is <>;
+ -- package Inner_G is
+ -- function "<" (L, R: T) return Boolean is (Compare (L, R));
+ -- end Inner_G;
+
+ -- If G is instantiated on the same actual type with a single Compare
+ -- function:
+
+ -- type T is ...
+ -- function Compare (L, R : T) return Boolean;
+ -- package My_G is new (T, T);
+
+ -- then the renaming generated for Compare in the inner instantiation
+ -- is ambiguous: it can rename either of the renamings generated for
+ -- the outer instantiation. Now if the first one is picked up, then
+ -- the subtypes of the formal parameters of the renaming will not be
+ -- preserved in Inherit_Renamed_Profile because they are subtypes of
+ -- the Bound_T formal type and not of the Item_T formal type, so we
+ -- need to arrange for the second one to be picked up instead.
+
+ while Present (New_F) loop
+ if Etype (Old1_F) /= Etype (Old2_F) then
+ Anc_T := Ancestor_Subtype (Etype (New_F));
+
+ if Etype (Old1_F) = Anc_T then
+ return Old1_S;
+ elsif Etype (Old2_F) = Anc_T then
+ return Old2_S;
+ end if;
+ end if;
+
+ Next_Formal (New_F);
+ Next_Formal (Old1_F);
+ Next_Formal (Old2_F);
+ end loop;
+
+ pragma Assert (No (Old1_F));
+ pragma Assert (No (Old2_F));
+
+ return Empty;
+ end Find_Nearer_Entity;
+
--------------------------
-- Is_Visible_Operation --
--------------------------
if Present (Inst) then
if Within (It.Nam, Inst) then
if Within (Old_S, Inst) then
-
- -- Choose the innermost subprogram, which would
- -- have hidden the outer one in the generic.
-
- if Scope_Depth (It.Nam) <
- Scope_Depth (Old_S)
- then
- return Old_S;
- else
- return It.Nam;
- end if;
+ declare
+ It_D : constant Uint := Scope_Depth (It.Nam);
+ Old_D : constant Uint := Scope_Depth (Old_S);
+ N_Ent : Entity_Id;
+ begin
+ -- Choose the innermost subprogram, which
+ -- would hide the outer one in the generic.
+
+ if Old_D > It_D then
+ return Old_S;
+ elsif It_D > Old_D then
+ return It.Nam;
+ end if;
+
+ -- Otherwise, if we can determine that one
+ -- of the entities is nearer to the renaming
+ -- than the other, choose it. If not, then
+ -- return the newer one as done historically.
+
+ N_Ent :=
+ Find_Nearer_Entity (New_S, Old_S, It.Nam);
+ if Present (N_Ent) then
+ return N_Ent;
+ else
+ return It.Nam;
+ end if;
+ end;
end if;
elsif Within (Old_S, Inst) then
- return (Old_S);
+ return Old_S;
else
return Report_Overload;
projects / thirdparty / gcc.git / commitdiff
