]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Small adjustments to new procedure Expand_Unchecked_Union_Equality
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 24 Jun 2023 17:30:55 +0000 (19:30 +0200)
committerMarc Poulhiès <poulhies@adacore.com>
Tue, 4 Jul 2023 08:08:28 +0000 (10:08 +0200)
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.

gcc/ada/exp_ch4.adb
gcc/ada/exp_ch4.ads
gcc/ada/exp_ch6.adb

index 638501313099329b98618f3e8afd15447839d05b..ec95d8b830ba1f0d95964e96efc528d3c1e5fe68 100644 (file)
@@ -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)
index e8d966c8c339c6bdd28daabd893395543b3a7a5d..39177cde369ef4d4686f3b8d2ef4e586b058ce62 100644 (file)
@@ -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
index 44ae10aa34228d8b9b6ff47b327c8d7734a67125..2e3a2b3edcc044a4fb3073c785f951b774e8956e 100644 (file)
@@ -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