diff options
| author | Justin Squirek <squirek@adacore.com> | 2020-11-20 08:11:12 -0500 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-12-14 10:51:54 -0500 |
| commit | 7e7d99bfa23c7d84ba48b9131e2134cf4049d791 (patch) | |
| tree | 792a4c3845fc21a11ed92e2cdd934ad2348adff6 /gcc | |
| parent | 90b2d3fafb965f1f557966b5842c324d19f5c131 (diff) | |
| download | gcc-7e7d99bfa23c7d84ba48b9131e2134cf4049d791.zip gcc-7e7d99bfa23c7d84ba48b9131e2134cf4049d791.tar.gz gcc-7e7d99bfa23c7d84ba48b9131e2134cf4049d791.tar.bz2 | |
[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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/sem_res.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 22 | ||||
| -rw-r--r-- | 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 659db86..05ebf20 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 72dbc68..30d4457 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 b2af43a..2e91359 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 |