diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5451,9 +5451,12 @@ package body Sem_Res is -- Do not apply Ada 2005 accessibility checks on a class-wide -- allocator if the type given in the allocator is a formal - -- type. A run-time check will be performed in the instance. + -- type or within a formal package. A run-time check will be + -- performed in the instance. - elsif not Is_Generic_Type (Exp_Typ) then + elsif not Is_Generic_Type (Exp_Typ) + and then not In_Generic_Formal_Package (Exp_Typ) + then Error_Msg_N ("type in allocator has deeper level than designated " & "class-wide type", E); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -13827,6 +13827,28 @@ package body Sem_Util is and then Assertion_Expression_Pragma (Get_Pragma_Id (Prag)); end In_Assertion_Expression_Pragma; + ------------------------------- + -- In_Generic_Formal_Package -- + ------------------------------- + + function In_Generic_Formal_Package (E : Entity_Id) return Boolean is + Par : Node_Id; + + begin + Par := Parent (E); + while Present (Par) loop + if Nkind (Par) = N_Formal_Package_Declaration + or else Nkind (Original_Node (Par)) = N_Formal_Package_Declaration + then + return True; + end if; + + Par := Parent (Par); + end loop; + + return False; + end In_Generic_Formal_Package; + ---------------------- -- In_Generic_Scope -- ---------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1538,6 +1538,9 @@ package Sem_Util is -- Returns True if node N appears within a pragma that acts as an assertion -- expression. See Sem_Prag for the list of qualifying pragmas. + function In_Generic_Formal_Package (E : Entity_Id) return Boolean; + -- Returns True if entity E is inside a generic formal package + function In_Generic_Scope (E : Entity_Id) return Boolean; -- Returns True if entity E is inside a generic scope