aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_util.adb
diff options
context:
space:
mode:
authorJustin Squirek <squirek@adacore.com>2020-05-22 16:25:00 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2020-07-16 05:18:03 -0400
commit25b4c873d19ccdc7e9a333eab8b5ab8e29a35976 (patch)
tree0ec545048cf43bd32db87b49f204613f3210d6c1 /gcc/ada/sem_util.adb
parente31f60f31da89f3c79b6dd8488a7eff03c689f1b (diff)
downloadgcc-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.adb17
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. ???)