[gcc r15-11451] Ada: Fix bogus error for 'Value invoked on function call and -gnatVa

Eric Botcazou via Gcc-cvs <[email protected]> Sun, 2 Aug 2026 12:14:07 +0000 (GMT)
Newsgroups gmane.comp.gcc.cvs
Message-ID <[email protected]>
https://gcc.gnu.org/g:75e1d682f3e623f413024b2693311113d4052da0

commit r15-11451-g75e1d682f3e623f413024b2693311113d4052da0
Author: Eric Botcazou <[email protected]>
Date:   Fri Jul 31 20:18:15 2026 +0200

    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:
---
 gcc/ada/exp_ch6.adb                       | 11 ++++++-----
 gcc/testsuite/gnat.dg/validity_check3.adb | 23 +++++++++++++++++++++++
 2 files changed, 29 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2b53cf99b4dd..7d5cf59fa68b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7389,13 +7389,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 000000000000..d710e26c7f9c
--- /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;