From 2e80be632bfd09987425cb0bdd271659673e1e43 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Sat, 24 Jun 2023 19:30:55 +0200
Subject: [PATCH] ada: Small adjustments to new procedure
Expand_Unchecked_Union_Equality
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 | 16 ++++++++++------
gcc/ada/exp_ch4.ads | 8 ++------
gcc/ada/exp_ch6.adb | 6 ++----
3 files changed, 14 insertions(+), 16 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 638501313099..ec95d8b830ba 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 e8d966c8c339..39177cde369e 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 44ae10aa3422..2e3a2b3edcc0 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
--
GitLab