diff options
author | Justin Squirek <squirek@adacore.com> | 2020-05-22 16:25:00 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-07-16 05:18:03 -0400 |
commit | 25b4c873d19ccdc7e9a333eab8b5ab8e29a35976 (patch) | |
tree | 0ec545048cf43bd32db87b49f204613f3210d6c1 /gcc/ada/sem_util.adb | |
parent | e31f60f31da89f3c79b6dd8488a7eff03c689f1b (diff) | |
download | gcc-25b4c873d19ccdc7e9a333eab8b5ab8e29a35976.zip gcc-25b4c873d19ccdc7e9a333eab8b5ab8e29a35976.tar.gz gcc-25b4c873d19ccdc7e9a333eab8b5ab8e29a35976.tar.bz2 |
[Ada] Incorrect static accessibility error in return aggregate
gcc/ada/
* einfo.adb, einfo.ads (Is_Named_Access_Type): Created for
readability.
* sem_ch6.adb (Check_Return_Construct_Accessibility): Add
special cases for formals.
* sem_util.adb (Object_Access_Level): Add handling of access
attributes and named access types in the general case.
Diffstat (limited to 'gcc/ada/sem_util.adb')
-rw-r--r-- | gcc/ada/sem_util.adb | 17 |
1 files changed, 16 insertions, 1 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 228cca2..2ce22e9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -24330,7 +24330,7 @@ package body Sem_Util is -- than the level of any visible named access type (see 3.10.2(21)). if Is_Type (E) then - return Type_Access_Level (E) + 1; + return Type_Access_Level (E) + 1; elsif Present (Renamed_Object (E)) then return Object_Access_Level (Renamed_Object (E)); @@ -24347,6 +24347,12 @@ package body Sem_Util is then return Type_Access_Level (Scope (E)) + 1; + -- An object of a named access type gets its level from its + -- associated type. + + elsif Is_Named_Access_Type (Etype (E)) then + return Type_Access_Level (Etype (E)); + else return Scope_Depth (Enclosing_Dynamic_Scope (E)); end if; @@ -24559,6 +24565,15 @@ package body Sem_Util is then return Object_Access_Level (Current_Scope); + -- Move up the attribute reference when we encounter a 'Access variation + + elsif Nkind (Orig_Obj) = N_Attribute_Reference + and then Nam_In (Attribute_Name (Orig_Obj), Name_Access, + Name_Unchecked_Access, + Name_Unrestricted_Access) + then + return Object_Access_Level (Prefix (Orig_Obj)); + -- Otherwise return the scope level of Standard. (If there are cases -- that fall through to this point they will be treated as having -- global accessibility for now. ???) |