[Ada] Spurious accessibility error on return aggregate in GNATprove mode
authorJustin Squirek <squirek@adacore.com>
Wed, 11 Dec 2019 03:49:43 +0000 (22:49 -0500)
committerPierre-Marie de Rodat <derodat@adacore.com>
Mon, 25 May 2020 14:00:54 +0000 (10:00 -0400)
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.

gcc/ada/ChangeLog
gcc/ada/sem_ch6.adb

index 09f81ba2486b94dd8ec9b446846b41f9513b3fd3..08c26768ccc78a0f798e2821d5d677e8759ecadd 100644 (file)
@@ -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
index eca05573321eaa283bf129e75bc2d23cd286273e..d79b7a26c0b277473dcfa6cd0a79f87a7bbf2b53 100644 (file)
@@ -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;