From 2f0067f47e5531e555c61f2ea9815fe8b088e877 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Tue, 17 Dec 2019 17:17:23 -0500 Subject: [PATCH] [Ada] Spurious accessibility error on return aggregate in GNATprove mode 2020-06-02 Justin Squirek gcc/ada/ * sem_ch6.adb (Check_Return_Obj_Accessibility): Avoid use of parent node pointers so we are not relying on expansion done in GNATprove mode. --- gcc/ada/sem_ch6.adb | 49 +++++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 26 deletions(-) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index d79b7a26c0b..c080e5706f9 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -814,51 +814,48 @@ package body Sem_Ch6 is -- named access types. Obj := Original_Node (Prefix (Expr)); - while Nkind_In (Obj, N_Indexed_Component, + while Nkind_In (Obj, N_Explicit_Dereference, + 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 (Obj)) + if Ekind (Etype (Original_Node (Prefix (Obj)))) in E_Access_Type .. E_Access_Protected_Subprogram_Type then - if Nkind (Parent (Obj)) = N_Selected_Component then - Obj := Selector_Name (Parent (Obj)); + if Nkind (Obj) = N_Selected_Component then + Obj := Selector_Name (Obj); + else + Obj := Original_Node (Prefix (Obj)); end if; exit; end if; - -- Skip over the explicit dereference - - if Nkind (Obj) = N_Explicit_Dereference then - Obj := Original_Node (Prefix (Obj)); - end if; + Obj := Original_Node (Prefix (Obj)); end loop; + if Nkind (Obj) = N_Selected_Component then + Obj := Selector_Name (Obj); + end if; + -- Do not check aliased formals or function calls. A -- run-time check may still be needed ??? - if Is_Entity_Name (Obj) - and then Comes_From_Source (Obj) - then - -- Explicitly aliased formals are allowed + pragma Assert (Is_Entity_Name (Obj)); - if Is_Formal (Entity (Obj)) - and then Is_Aliased (Entity (Obj)) - then - null; + if Is_Formal (Entity (Obj)) + and then Is_Aliased (Entity (Obj)) + then + null; - elsif Object_Access_Level (Obj) > - Scope_Depth (Scope (Scope_Id)) - then - Error_Msg_N - ("access discriminant in return aggregate would " - & "be a dangling reference", Obj); - end if; + elsif Object_Access_Level (Obj) > + Scope_Depth (Scope (Scope_Id)) + then + Error_Msg_N + ("access discriminant in return aggregate would " + & "be a dangling reference", Obj); end if; end if; end if; -- 2.30.2