From 4354291994e6f6cb6eba1acef3192fa5c18b1274 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Tue, 10 Dec 2019 22:49:43 -0500 Subject: [PATCH] [Ada] Spurious accessibility error on return aggregate in GNATprove mode 2020-05-25 Justin Squirek gcc/ada/ * sem_ch6.adb (Check_Return_Obj_Accessibility): Use original node to avoid looking at expansion done in GNATprove mode. --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_ch6.adb | 24 ++++++++++++------------ 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 + + * sem_ch6.adb (Check_Return_Obj_Accessibility): Use original + node to avoid looking at expansion done in GNATprove mode. + 2020-05-25 Eric Botcazou * 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; -- 2.7.4