[COMMITTED] ada: Small adjustments to new procedure Expand_Unchecked_Union_Equality

Message ID 20230704080947.998876-1-poulhies@adacore.com
State Unresolved
Headers
Series [COMMITTED] ada: Small adjustments to new procedure Expand_Unchecked_Union_Equality |

Checks

Context Check Description
snail/gcc-patch-check warning Git am fail log

Commit Message

Marc Poulhiès July 4, 2023, 8:09 a.m. UTC
  From: Eric Botcazou <ebotcazou@adacore.com>

The procedure is not stable under repeated invocation.  Now it may be called
twice on the same node, for example during the expansion of the renaming of
the predefined equality operator after the unchecked union type is frozen.

gcc/ada/

	* exp_ch4.ads (Expand_Unchecked_Union_Equality): Only take a
	single parameter.
	* exp_ch4.adb (Expand_Unchecked_Union_Equality): Add guard against
	repeated invocation on the same node.
	* exp_ch6.adb (Expand_Call): Only pass a single actual parameter
	in the call to Expand_Unchecked_Union_Equality.

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

---
 gcc/ada/exp_ch4.adb | 16 ++++++++++------
 gcc/ada/exp_ch4.ads |  8 ++------
 gcc/ada/exp_ch6.adb |  6 ++----
 3 files changed, 14 insertions(+), 16 deletions(-)
  

Patch

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 63850131309..ec95d8b830b 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -13158,13 +13158,11 @@  package body Exp_Ch4 is
    -- Expand_Unchecked_Union_Equality --
    -------------------------------------
 
-   procedure Expand_Unchecked_Union_Equality
-     (N   : Node_Id;
-      Eq  : Entity_Id;
-      Lhs : Node_Id;
-      Rhs : Node_Id)
-   is
+   procedure Expand_Unchecked_Union_Equality (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
+      Eq  : constant Entity_Id  := Entity (Name (N));
+      Lhs : constant Node_Id    := First_Actual (N);
+      Rhs : constant Node_Id    := Next_Actual (Lhs);
 
       function Get_Discr_Values (Op : Node_Id; Lhs : Boolean) return Elist_Id;
       --  Return the list of inferred discriminant values for Op
@@ -13335,6 +13333,12 @@  package body Exp_Ch4 is
    --  Start of processing for Expand_Unchecked_Union_Equality
 
    begin
+      --  Guard against repeated invocation on the same node
+
+      if Present (Next_Actual (Rhs)) then
+         return;
+      end if;
+
       --  If we can infer the discriminants of the operands, make a call to Eq
 
       if Has_Inferable_Discriminants (Lhs)
diff --git a/gcc/ada/exp_ch4.ads b/gcc/ada/exp_ch4.ads
index e8d966c8c33..39177cde369 100644
--- a/gcc/ada/exp_ch4.ads
+++ b/gcc/ada/exp_ch4.ads
@@ -105,13 +105,9 @@  package Exp_Ch4 is
    --  membership test. The whole membership is rewritten connecting these
    --  with OR ELSE.
 
-   procedure Expand_Unchecked_Union_Equality
-     (N   : Node_Id;
-      Eq  : Entity_Id;
-      Lhs : Node_Id;
-      Rhs : Node_Id);
+   procedure Expand_Unchecked_Union_Equality (N : Node_Id);
    --  Expand a call to the predefined equality operator of an unchecked union
-   --  type, possibly rewriting as a raise statement.
+   --  type, possibly rewriting it as a raise statement.
 
    function Integer_Promotion_Possible (N : Node_Id) return Boolean;
    --  Returns true if the node is a type conversion whose operand is an
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 44ae10aa342..2e3a2b3edcc 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -2933,12 +2933,10 @@  package body Exp_Ch6 is
 
       elsif Is_Unchecked_Union_Equality (N) then
          declare
-            Eq  : constant Entity_Id := Entity (Name (N));
-            Lhs : constant Node_Id   := First_Actual (N);
-            Rhs : constant Node_Id   := Next_Actual (Lhs);
+            Eq : constant Entity_Id := Entity (Name (N));
 
          begin
-            Expand_Unchecked_Union_Equality (N, Eq, Lhs, Rhs);
+            Expand_Unchecked_Union_Equality (N);
 
             --  If the call was not rewritten as a raise, expand the actuals