From 1f5c7ba85856618c1f14d4f581966baadbe02ddd Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 19 Aug 2019 08:36:21 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_dist.adb | 36 +++++++++++++++++++++++++++++++++--- 2 files changed, 40 insertions(+), 3 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64f3cbb7c37..5d48b3d31d1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-19 Eric Botcazou + + * 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 * sem_warn.adb (Check_References, Generic_Body_Formal): When a diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 4f13d9cedaf..89218c4a921 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -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 -- ---------------------------