aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJustin Squirek <squirek@adacore.com>2019-12-10 22:49:43 -0500
committerPierre-Marie de Rodat <derodat@adacore.com>2020-05-25 10:00:54 -0400
commit4354291994e6f6cb6eba1acef3192fa5c18b1274 (patch)
tree50898cdff6edd6dbc8f0cfb2ab2c057532598d5e /gcc
parenta746f952abb78af9db28a7f3bce442e113877c9c (diff)
downloadgcc-4354291994e6f6cb6eba1acef3192fa5c18b1274.zip
gcc-4354291994e6f6cb6eba1acef3192fa5c18b1274.tar.gz
gcc-4354291994e6f6cb6eba1acef3192fa5c18b1274.tar.bz2
[Ada] Spurious accessibility error on return aggregate in GNATprove mode
2020-05-25 Justin Squirek <squirek@adacore.com> gcc/ada/ * sem_ch6.adb (Check_Return_Obj_Accessibility): Use original node to avoid looking at expansion done in GNATprove mode.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/sem_ch6.adb24
2 files changed, 17 insertions, 12 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 09f81ba..08c2676 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2020-05-25 Justin Squirek <squirek@adacore.com>
+
+ * sem_ch6.adb (Check_Return_Obj_Accessibility): Use original
+ node to avoid looking at expansion done in GNATprove mode.
+
2020-05-25 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Add new local variable
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index eca0557..d79b7a2 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -798,44 +798,44 @@ package body Sem_Ch6 is
N_Discriminant_Association)
then
Expr := Expression (Assoc);
+ else
+ Expr := Empty;
end if;
-- This anonymous access discriminant has an associated
-- expression which needs checking.
- if Nkind (Expr) = N_Attribute_Reference
+ if Present (Expr)
+ and then Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) /= Name_Unrestricted_Access
then
-- Obtain the object to perform static checks on by moving
-- up the prefixes in the expression taking into account
-- named access types.
- Obj := Prefix (Expr);
+ Obj := Original_Node (Prefix (Expr));
while Nkind_In (Obj, N_Indexed_Component,
N_Selected_Component)
loop
+ Obj := Original_Node (Prefix (Obj));
+
-- When we encounter a named access type then we can
-- ignore accessibility checks on the dereference.
- if Ekind (Etype (Prefix (Obj)))
+ if Ekind (Etype (Obj))
in E_Access_Type ..
E_Access_Protected_Subprogram_Type
then
- if Nkind (Obj) = N_Selected_Component then
- Obj := Selector_Name (Obj);
+ if Nkind (Parent (Obj)) = N_Selected_Component then
+ Obj := Selector_Name (Parent (Obj));
end if;
exit;
end if;
-- Skip over the explicit dereference
- if Nkind (Prefix (Obj)) = N_Explicit_Dereference then
- Obj := Prefix (Prefix (Obj));
-
- -- Otherwise move up to the next prefix
-
- else
- Obj := Prefix (Obj);
+ if Nkind (Obj) = N_Explicit_Dereference then
+ Obj := Original_Node (Prefix (Obj));
end if;
end loop;