[Ada] Fix incorrect stub generation for types in instances

This fixes a fallout of a recent change clearing the
Is_Generic_Actual_Type on the implicit full view of a private actual
type in an instance.  This flag is used to help disambiguating formal
types instantiated on the same actual type within an instance, but it
should be cleared outside the instance to let the usual disambiguation
rules apply again to these types outside the instance.

This in particular means that Exp_Dist cannot rely on it to detect
subtypes representing generic actual types, hence the need for the new
predicate.

2019-08-19  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_dist.adb (Is_Generic_Actual_Subtype): New predicate.
	(Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call):
	Use it instead of Is_Generic_Actual_Type flag to detect subtypes
	representing generic actual types.

From-SVN: r274650
This commit is contained in:
Eric Botcazou 2019-08-19 08:36:21 +00:00 committed by Pierre-Marie de Rodat
parent 4527ea2ed9
commit 1f5c7ba858
2 changed files with 40 additions and 3 deletions

View File

@ -1,3 +1,10 @@
2019-08-19 Eric Botcazou <ebotcazou@adacore.com>
* exp_dist.adb (Is_Generic_Actual_Subtype): New predicate.
(Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call):
Use it instead of Is_Generic_Actual_Type flag to detect subtypes
representing generic actual types.
2019-08-19 Ed Schonberg <schonberg@adacore.com>
* sem_warn.adb (Check_References, Generic_Body_Formal): When a

View File

@ -8201,6 +8201,12 @@ package body Exp_Dist is
-- type from Interfaces, or the smallest floating point type from
-- Standard whose range encompasses that of Typ.
function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean;
-- Return true if Typ is a subtype representing a generic formal type
-- as a subtype of the actual type in an instance. This is needed to
-- recognize these subtypes because the Is_Generic_Actual_Type flag
-- can only be relied upon within the instance.
function Make_Helper_Function_Name
(Loc : Source_Ptr;
Typ : Entity_Id;
@ -8453,7 +8459,7 @@ package body Exp_Dist is
-- For the subtype representing a generic actual type, go to the
-- actual type.
if Is_Generic_Actual_Type (U_Type) then
if Is_Generic_Actual_Subtype (U_Type) then
U_Type := Underlying_Type (Base_Type (U_Type));
end if;
@ -9262,7 +9268,7 @@ package body Exp_Dist is
-- For the subtype representing a generic actual type, go to the
-- actual type.
if Is_Generic_Actual_Type (U_Type) then
if Is_Generic_Actual_Subtype (U_Type) then
U_Type := Underlying_Type (Base_Type (U_Type));
end if;
@ -10116,7 +10122,7 @@ package body Exp_Dist is
-- For the subtype representing a generic actual type, go to the
-- actual type.
if Is_Generic_Actual_Type (U_Type) then
if Is_Generic_Actual_Subtype (U_Type) then
U_Type := Underlying_Type (Base_Type (U_Type));
end if;
@ -10901,6 +10907,30 @@ package body Exp_Dist is
end Find_Numeric_Representation;
---------------------------------
-- Is_Generic_Actual_Subtype --
---------------------------------
function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean is
begin
if Is_Itype (Typ)
and then Present (Associated_Node_For_Itype (Typ))
then
declare
N : constant Node_Id := Associated_Node_For_Itype (Typ);
begin
if Nkind (N) = N_Subtype_Declaration
and then Nkind (Parent (N)) = N_Package_Specification
and then Is_Generic_Instance (Scope_Of_Spec (Parent (N)))
then
return True;
end if;
end;
end if;
return False;
end Is_Generic_Actual_Subtype;
---------------------------
-- Append_Array_Traversal --
---------------------------