Ada: Fix bogus error for 'Value invoked on function call and -gnatVa

This happens when the function takes an In Out or Out parameter, so only in
Ada 2012 and later.  The mechanism used to implement the validity check for
the call, required by -gnatVa, inserts the copy-out statement incorrectly.

gcc/ada/
	PR ada/126379
	* exp_ch6.adb (Insert_Post_Call_Actions): Also deal with attribute
	references as parent node.

gcc/testsuite/
	* gnat.dg/validity_check3.adb: New test.

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index d9ab5ee108cbec7799fc700a8ea77a95c56f9da9..53f889689611adc5c1d75fd6f05c0b48d0c70a74 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7859,13 +7859,14 @@ package body Exp_Ch6 is
          return;
       end if;
 
-      --  Cases where the call is not a member of a statement list. This also
-      --  includes the cases where the call is an actual in another function
-      --  call, or is an index, or is an operand of an if-expression, i.e. is
-      --  in an expression context.
+      --  Cases where the call is not a member of a statement list, or cases
+      --  where the call is an actual in an attribute reference, or in another
+      --  function call, or is an index, or is an operand of an if-expression,
+      --  i.e. is in an expression context.
 
       if not Is_List_Member (N)
-        or else Nkind (Context) in N_Function_Call
+        or else Nkind (Context) in N_Attribute_Reference
+                                 | N_Function_Call
                                  | N_If_Expression
                                  | N_Indexed_Component
       then

diff --git a/gcc/testsuite/gnat.dg/validity_check3.adb b/gcc/testsuite/gnat.dg/validity_check3.adb
new file mode 100644 (file)
index 0000000..d710e26
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/validity_check3.adb
@@ -0,0 +1,23 @@
+--  { dg-do compile }
+--  { dg-options "-gnatVa" }
+
+procedure Validity_Check3 is
+
+   type Selection is (First, Second);
+
+   function Next_Value (Text     : String;
+                        Position : in out Positive) return String is
+   begin
+      Position := Position + 1;
+      return Text;
+   end Next_Value;
+
+   Position : Positive := 1;
+   Value    : constant Selection :=
+     Selection'Value (Next_Value ("First", Position));
+
+begin
+   if Value /= First then
+      raise Program_Error;
+   end if;
+end;