From 7e7d99bfa23c7d84ba48b9131e2134cf4049d791 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Fri, 20 Nov 2020 08:11:12 -0500 Subject: [PATCH] [Ada] Incorrect accessibility level on type in formal package gcc/ada/ * sem_util.adb, sem_util.ads (In_Generic_Formal_Package): Created to identify type declarations occurring within generic formal packages. * sem_res.adb (Resolve_Allocator): Add condition to avoid emitting an error for allocators when the type being allocated is class-wide and from a generic formal package. --- gcc/ada/sem_res.adb | 7 +++++-- gcc/ada/sem_util.adb | 22 ++++++++++++++++++++++ gcc/ada/sem_util.ads | 3 +++ 3 files changed, 30 insertions(+), 2 deletions(-) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 659db865f93..05ebf20ca26 100644 --- 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 index 72dbc6868af..30d4457ea31 100644 --- 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 index b2af43a7406..2e913594bc0 100644 --- 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 -- 2.30.2