From: Arnaud Charlet <charlet@adacore.com>
Date: Wed, 25 Mar 2020 17:39:46 +0000 (-0400)
Subject: [Ada] Fix handling of Ada 83 OUT parameter rule
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f40a4e4caba84726e3502ad2b11a3e2fac5af093;p=gcc.git

[Ada] Fix handling of Ada 83 OUT parameter rule

2020-06-12  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* sem_res.adb (Resolve_Entity_Name): Fix handling of expressions
	containing array attributes wrt Ada 83 detection.
---

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 4cd6f060eb5..57c247f29ce 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7370,6 +7370,10 @@ package body Sem_Res is
       --  Determine whether node Context denotes an assignment statement or an
       --  object declaration whose expression is node Expr.
 
+      function Is_Attribute_Expression (Expr : Node_Id) return Boolean;
+      --  Determine whether Expr is part of an N_Attribute_Reference
+      --  expression.
+
       ----------------------------------------
       -- Is_Assignment_Or_Object_Expression --
       ----------------------------------------
@@ -7412,6 +7416,24 @@ package body Sem_Res is
          end if;
       end Is_Assignment_Or_Object_Expression;
 
+      -----------------------------
+      -- Is_Attribute_Expression --
+      -----------------------------
+
+      function Is_Attribute_Expression (Expr : Node_Id) return Boolean is
+         N : Node_Id := Expr;
+      begin
+         while Present (N) loop
+            if Nkind (N) = N_Attribute_Reference then
+               return True;
+            end if;
+
+            N := Parent (N);
+         end loop;
+
+         return False;
+      end Is_Attribute_Expression;
+
       --  Local variables
 
       E   : constant Entity_Id := Entity (N);
@@ -7482,8 +7504,8 @@ package body Sem_Res is
       --  array types (i.e. bounds and length) are legal.
 
       elsif Ekind (E) = E_Out_Parameter
-        and then (Nkind (Parent (N)) /= N_Attribute_Reference
-                   or else Is_Scalar_Type (Etype (E)))
+        and then (Is_Scalar_Type (Etype (E))
+                   or else not Is_Attribute_Expression (Parent (N)))
 
         and then (Nkind (Parent (N)) in N_Op
                    or else Nkind (Parent (N)) = N_Explicit_Dereference