OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Don't carry action bodies for expansion of array equality

Browse Source 
gcc/ada/

	* exp_ch3.adb (Make_Eq_Body): Adapt call to
	Expand_Record_Equality.
	* exp_ch4.ads, exp_ch4.adb (Expand_Composite_Equality): Remove
	Bodies parameter; adapt comment; fix style in body; adapt calls
	to Expand_Record_Equality.
	(Expand_Array_Equality): Adapt calls to
	Expand_Composite_Equality.
	(Expand_Record_Equality): Remove Bodies parameter; adapt
	comment; adapt call to Expand_Composite_Equality.
	* exp_ch8.adb (Build_Body_For_Renaming): Adapt call to
	Expand_Record_Equality.
This commit is contained in:
Piotr Trojanek 2021-11-01 09:20:17 +01:00 committed by Pierre-Marie de Rodat
parent 0c66423ac9
commit 99f8a65368
4 changed files with 34 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/exp_ch3.adb
View File

@ -9864,10 +9864,9 @@ package body Exp_Ch3 is
Expression =>
Expand_Record_Equality
(Typ,
Typ => Typ,
Lhs => Make_Identifier (Loc, Name_X),
Rhs => Make_Identifier (Loc, Name_Y),
Bodies => Declarations (Decl))));
Typ => Typ,
Lhs => Make_Identifier (Loc, Name_X),
Rhs => Make_Identifier (Loc, Name_Y))));
end if;
Set_Handled_Statement_Sequence

58
gcc/ada/exp_ch4.adb
View File

@ -146,18 +146,14 @@ package body Exp_Ch4 is
-- where we allow comparison of "out of range" values.
function Expand_Composite_Equality
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id;
Bodies : List_Id) return Node_Id;
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id) return Node_Id;
-- Local recursive function used to expand equality for nested composite
-- types. Used by Expand_Record/Array_Equality, Bodies is a list on which
-- to attach bodies of local functions that are created in the process. It
-- is the responsibility of the caller to insert those bodies at the right
-- place. Nod provides the Sloc value for generated code. Lhs and Rhs are
-- the left and right sides for the comparison, and Typ is the type of the
-- objects to compare.
-- types. Used by Expand_Record/Array_Equality. Nod provides the Sloc value
-- for generated code. Lhs and Rhs are the left and right sides for the
-- comparison, and Typ is the type of the objects to compare.
procedure Expand_Concatenate (Cnode : Node_Id; Opnds : List_Id);
-- Routine to expand concatenation of a sequence of two or more operands
@ -1722,8 +1718,7 @@ package body Exp_Ch4 is
Prefix => Make_Identifier (Loc, Chars (B)),
Expressions => Index_List2);
Test := Expand_Composite_Equality
(Nod, Component_Type (Typ), L, R, Decls);
Test := Expand_Composite_Equality (Nod, Component_Type (Typ), L, R);
-- If some (sub)component is an unchecked_union, the whole operation
-- will raise program error.
@ -2012,7 +2007,7 @@ package body Exp_Ch4 is
Prefix => New_Copy_Tree (New_Rhs),
Expressions => New_List (New_Copy_Tree (Low_B)));
TestL := Expand_Composite_Equality (Nod, Ctyp, L, R, Bodies);
TestL := Expand_Composite_Equality (Nod, Ctyp, L, R);
L :=
Make_Indexed_Component (Loc,
@ -2024,7 +2019,7 @@ package body Exp_Ch4 is
Prefix => New_Rhs,
Expressions => New_List (New_Copy_Tree (High_B)));
TestH := Expand_Composite_Equality (Nod, Ctyp, L, R, Bodies);
TestH := Expand_Composite_Equality (Nod, Ctyp, L, R);
return
Make_And_Then (Loc, Left_Opnd => TestL, Right_Opnd => TestH);
@ -2437,18 +2432,15 @@ package body Exp_Ch4 is
-- case because it is not possible to respect normal Ada visibility rules.
function Expand_Composite_Equality
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id;
Bodies : List_Id) return Node_Id
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Nod);
Full_Type : Entity_Id;
Eq_Op : Entity_Id;
-- Start of processing for Expand_Composite_Equality
begin
if Is_Private_Type (Typ) then
Full_Type := Underlying_Type (Typ);
@ -2665,7 +2657,7 @@ package body Exp_Ch4 is
end;
else
return Expand_Record_Equality (Nod, Full_Type, Lhs, Rhs, Bodies);
return Expand_Record_Equality (Nod, Full_Type, Lhs, Rhs);
end if;
-- Case of non-record types (always use predefined equality)
@ -8640,10 +8632,8 @@ package body Exp_Ch4 is
else
Remove_Side_Effects (Lhs);
Remove_Side_Effects (Rhs);
Rewrite (N,
Expand_Record_Equality (N, Typl, Lhs, Rhs, Bodies));
Rewrite (N, Expand_Record_Equality (N, Typl, Lhs, Rhs));
Insert_Actions (N, Bodies, Suppress => All_Checks);
Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks);
end if;
@ -8666,10 +8656,8 @@ package body Exp_Ch4 is
Rewrite (N,
Expand_Record_Equality (N, Typl,
Unchecked_Convert_To (Typl, Lhs),
Unchecked_Convert_To (Typl, Rhs),
Bodies));
Unchecked_Convert_To (Typl, Rhs)));
Insert_Actions (N, Bodies, Suppress => All_Checks);
Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks);
end if;
@ -12994,11 +12982,10 @@ package body Exp_Ch4 is
-- otherwise the primitive "=" is used directly.
function Expand_Record_Equality
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id;
Bodies : List_Id) return Node_Id
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Nod);
@ -13085,8 +13072,7 @@ package body Exp_Ch4 is
Rhs =>
Make_Selected_Component (Loc,
Prefix => New_Rhs,
Selector_Name => New_Occurrence_Of (C, Loc)),
Bodies => Bodies);
Selector_Name => New_Occurrence_Of (C, Loc)));
-- If some (sub)component is an unchecked_union, the whole
-- operation will raise program error.

14
gcc/ada/exp_ch4.ads
View File

@ -89,20 +89,16 @@ package Exp_Ch4 is
-- while for records without variants only a simple expression is needed.
function Expand_Record_Equality
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id;
Bodies : List_Id) return Node_Id;
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id) return Node_Id;
-- Expand a record equality into an expression that compares the fields
-- individually to yield the required Boolean result. Loc is the
-- location for the generated nodes. Typ is the type of the record, and
-- Lhs, Rhs are the record expressions to be compared, these
-- expressions need not to be analyzed but have to be side-effect free.
-- Bodies is a list on which to attach bodies of local functions that
-- are created in the process. This is the responsibility of the caller
-- to insert those bodies at the right place. Nod provides the Sloc
-- value for generated code.
-- Nod provides the Sloc value for generated code.
procedure Expand_Set_Membership (N : Node_Id);
-- For each choice of a set membership, we create a simple equality or

16
gcc/ada/exp_ch8.adb
View File

@ -288,7 +288,6 @@ package body Exp_Ch8 is
function Build_Body_For_Renaming (Typ : Entity_Id) return Node_Id is
Left : constant Entity_Id := First_Formal (Id);
Right : constant Entity_Id := Next_Formal (Left);
Bodies : List_Id;
Body_Id : Entity_Id;
Decl : Node_Id;
@ -318,12 +317,6 @@ package body Exp_Ch8 is
-- subprogram.
else
-- While expanding record equality we might create auxiliary
-- subprograms that will be placed in the declaration list of the
-- equality subprogram itself.
Bodies := Empty_List;
Decl :=
Make_Subprogram_Body (Loc,
Specification =>
@ -332,7 +325,7 @@ package body Exp_Ch8 is
Parameter_Specifications => Copy_Parameter_List (Id),
Result_Definition =>
New_Occurrence_Of (Standard_Boolean, Loc)),
Declarations => Bodies,
Declarations => Empty_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
@ -340,10 +333,9 @@ package body Exp_Ch8 is
Expression =>
Expand_Record_Equality
(Id,
Typ => Typ,
Lhs => Make_Identifier (Loc, Chars (Left)),
Rhs => Make_Identifier (Loc, Chars (Right)),
Bodies => Bodies)))));
Typ => Typ,
Lhs => Make_Identifier (Loc, Chars (Left)),
Rhs => Make_Identifier (Loc, Chars (Right)))))));
end if;
return Decl;