diff mbox series

[Ada] Fix handling of Ada 83 OUT parameter rule

Message ID 20200612083546.GA73993@adacore.com
State New
Headers show
Series [Ada] Fix handling of Ada 83 OUT parameter rule | expand

Commit Message

Pierre-Marie de Rodat June 12, 2020, 8:35 a.m. UTC 
The current code was climbing the tree manually assuming that an array
attribute (e.g. 'First) would appear immediately, which isn't the case
for e.g. a selected component expression.

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

--- gcc/ada/sem_res.adb
+++ 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