From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 31 Jul 2026 18:18:15 +0000 (+0200)
Subject: Ada: Fix bogus error for 'Value invoked on function call and -gnatVa
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5ff1facfba558514eae0efaeb70adb91b6c32a5f;p=thirdparty%2Fgcc.git

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 d9ab5ee108c..53f88968961 100644
--- 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
index 00000000000..d710e26c7f9
--- /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;