[Ada] Spurious accessibility error on return aggregate in GNATprove mode

2020-06-02  Justin Squirek  <squirek@adacore.com>

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.

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d79b7a26c0b277473dcfa6cd0a79f87a7bbf2b53..c080e5706f9de742158d8bde81c9d096d18a8a2a 100644 (file)
--- 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;