[COMMITTED] ada: Small adjustments to new procedure Expand_Unchecked_Union_Equality
Checks
Commit Message
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(-)
@@ -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)
@@ -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
@@ -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