public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Eric Botcazou <ebotcazou@adacore.com>
Subject: [COMMITTED] ada: Fix internal error on conversion as in/out actual with -gnatVa
Date: Mon, 28 Nov 2022 13:04:58 +0100	[thread overview]
Message-ID: <20221128120458.171543-1-poulhies@adacore.com> (raw)

From: Eric Botcazou <ebotcazou@adacore.com>

The problem is that the regular expansion of the conversion around the
call to the subprogram is disabled by the expansion of the validity check
around the same call, as documented in Expand_Actuals:

  --  This case is given higher priority because the subsequent check
  --  for type conversion may add an extra copy of the variable and
  --  prevent proper value propagation back in the original object.

Now the two mechanisms need to cooperate in order for the code to compile.

gcc/ada/

	* exp_ch6.adb (Expand_Actuals.Add_Call_By_Copy_Code): Deal with a
	reference to a validation variable in the actual.
	(Expand_Actuals.Add_Validation_Call_By_Copy_Code): Minor tweak.
	(Expand_Actuals): Call Add_Validation_Call_By_Copy_Code directly
	only if Add_Call_By_Copy_Code is not to be invoked.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch6.adb | 61 ++++++++++++++++++++++++++++++++-------------
 1 file changed, 43 insertions(+), 18 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 237a19d1327..0fe980c499a 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1639,6 +1639,27 @@ package body Exp_Ch6 is
             Crep  := False;
          end if;
 
+         --  If the actual denotes a variable which captures the value of an
+         --  object for validation purposes, we propagate the link with this
+         --  object to the new variable made from the actual just above.
+
+         if Ekind (Formal) /= E_In_Parameter
+           and then Is_Validation_Variable_Reference (Actual)
+         then
+            declare
+               Ref : constant Node_Id := Unqual_Conv (Actual);
+
+            begin
+               if Is_Entity_Name (Ref) then
+                  Set_Validated_Object (Var, Validated_Object (Entity (Ref)));
+
+               else
+                  pragma Assert (False);
+                  null;
+               end if;
+            end;
+         end if;
+
          --  Setup initialization for case of in out parameter, or an out
          --  parameter where the formal is an unconstrained array (in the
          --  latter case, we have to pass in an object with bounds).
@@ -1906,6 +1927,13 @@ package body Exp_Ch6 is
                       Name       => Lhs,
                       Expression => Expr));
                end if;
+
+               --  Add a copy-back to reflect any potential changes in value
+               --  back into the original object, if any.
+
+               if Is_Validation_Variable_Reference (Lhs) then
+                  Add_Validation_Call_By_Copy_Code (Lhs);
+               end if;
             end;
          end if;
       end Add_Call_By_Copy_Code;
@@ -2052,10 +2080,11 @@ package body Exp_Ch6 is
       --------------------------------------
 
       procedure Add_Validation_Call_By_Copy_Code (Act : Node_Id) is
+         Var : constant Node_Id := Unqual_Conv (Act);
+
          Expr    : Node_Id;
          Obj     : Node_Id;
          Obj_Typ : Entity_Id;
-         Var     : constant Node_Id := Unqual_Conv (Act);
          Var_Id  : Entity_Id;
 
       begin
@@ -2405,26 +2434,10 @@ package body Exp_Ch6 is
                end if;
             end if;
 
-            --  The actual denotes a variable which captures the value of an
-            --  object for validation purposes. Add a copy-back to reflect any
-            --  potential changes in value back into the original object.
-
-            --    Var : ... := Object;
-            --    if not Var'Valid then  --  validity check
-            --    Call (Var);            --  modify var
-            --    Object := Var;         --  update Object
-
-            --  This case is given higher priority because the subsequent check
-            --  for type conversion may add an extra copy of the variable and
-            --  prevent proper value propagation back in the original object.
-
-            if Is_Validation_Variable_Reference (Actual) then
-               Add_Validation_Call_By_Copy_Code (Actual);
-
             --  If argument is a type conversion for a type that is passed by
             --  copy, then we must pass the parameter by copy.
 
-            elsif Nkind (Actual) = N_Type_Conversion
+            if Nkind (Actual) = N_Type_Conversion
               and then
                 (Is_Elementary_Type (E_Formal)
                   or else Is_Bit_Packed_Array (Etype (Formal))
@@ -2508,6 +2521,18 @@ package body Exp_Ch6 is
                       and then not In_Subrange_Of (E_Actual, E_Formal)))
             then
                Add_Call_By_Copy_Code;
+
+            --  The actual denotes a variable which captures the value of an
+            --  object for validation purposes. Add a copy-back to reflect any
+            --  potential changes in value back into the original object.
+
+            --    Var : ... := Object;
+            --    if not Var'Valid then  --  validity check
+            --    Call (Var);            --  modify var
+            --    Object := Var;         --  update Object
+
+            elsif Is_Validation_Variable_Reference (Actual) then
+               Add_Validation_Call_By_Copy_Code (Actual);
             end if;
 
             --  RM 3.2.4 (23/3): A predicate is checked on in-out and out
-- 
2.34.1


                 reply	other threads:[~2022-11-28 12:05 UTC|newest]

Thread overview: [no followups] expand[flat|nested]  mbox.gz  Atom feed

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20221128120458.171543-1-poulhies@adacore.com \
    --to=poulhies@adacore.com \
    --cc=ebotcazou@adacore.com \
    --cc=gcc-patches@gcc.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).