FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

ada: Use accumulator type in expansion of 'Reduce attribute

Browse source 
The current expansion of the 'Reduce attribute uses the resolution type of
the expression for the accumulator. Now this type can be unresolved or set
to a universal type, for example if it is itself the prefix of the 'Image
attribute, and this may yield a spurious type mismatch error in that case.

This changes the expansion to use the accumulator type instead as defined
by the RM 4.5.10 clause, albeit only in the prefixed case for now.

gcc/ada/

	* exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Reduce>:
	Use the canonical accumulator type as the type of the accumulator
	in the prefixed case.
This commit is contained in:
Eric Botcazou 2023-01-26 15:59:37 +01:00 • committed by Marc Poulhiès
parent e07e6ea692
commit 9a70dce278
1 changed files with 62 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

72
gcc/ada/exp_attr.adb
View file

@ -5978,27 +5978,30 @@ package body Exp_Attr is
when Attribute_Reduce =>
declare
Loc : constant Source_Ptr := Sloc (N);
E1 : constant Node_Id := First (Expressions (N));
E2 : constant Node_Id := Next (E1);
Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
Typ : constant Entity_Id := Etype (N);
E1 : constant Node_Id := First (Expressions (N));
E2 : constant Node_Id := Next (E1);
Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
New_Loop : Node_Id;
Stat : Node_Id;
Accum_Typ : Entity_Id;
New_Loop : Node_Id;
function Build_Stat (Comp : Node_Id) return Node_Id;
-- The reducer can be a function, a procedure whose first
-- parameter is in-out, or an attribute that is a function,
-- which (for now) can only be Min/Max. This subprogram
-- builds the corresponding computation for the generated loop.
-- builds the corresponding computation for the generated loop
-- and retrieves the accumulator type as per RM 4.5.10(19/5).
----------------
-- Build_Stat --
----------------
function Build_Stat (Comp : Node_Id) return Node_Id is
Stat : Node_Id;
begin
if Nkind (E1) = N_Attribute_Reference then
Accum_Typ := Entity (Prefix (E1));
Stat := Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Bnn, Loc),
Expression => Make_Attribute_Reference (Loc,
@ -6009,12 +6012,14 @@ package body Exp_Attr is
Comp)));
elsif Ekind (Entity (E1)) = E_Procedure then
Accum_Typ := Etype (First_Formal (Entity (E1)));
Stat := Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Entity (E1), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Bnn, Loc),
Comp));
else
Accum_Typ := Etype (Entity (E1));
Stat := Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Bnn, Loc),
Expression => Make_Function_Call (Loc,
@ -6074,6 +6079,13 @@ package body Exp_Attr is
End_Label => Empty,
Statements =>
New_List (Build_Stat (Relocate_Node (Expr))));
-- If the reducer subprogram is a universal operator, then
-- we still look at the context to find the type for now.
if Is_Universal_Numeric_Type (Accum_Typ) then
Accum_Typ := Etype (N);
end if;
end;
else
@ -6082,9 +6094,10 @@ package body Exp_Attr is
-- a container with the proper aspects.
declare
Iter : Node_Id;
Elem : constant Entity_Id := Make_Temporary (Loc, 'E', N);
Iter : Node_Id;
begin
Iter :=
Make_Iterator_Specification (Loc,
@ -6101,6 +6114,44 @@ package body Exp_Attr is
End_Label => Empty,
Statements => New_List (
Build_Stat (New_Occurrence_Of (Elem, Loc))));
-- If the reducer subprogram is a universal operator, then
-- we need to look at the prefix to find the type. This is
-- modeled on Analyze_Iterator_Specification in Sem_Ch5.
if Is_Universal_Numeric_Type (Accum_Typ) then
declare
Ptyp : constant Entity_Id :=
Base_Type (Etype (Prefix (N)));
begin
if Is_Array_Type (Ptyp) then
Accum_Typ := Component_Type (Ptyp);
elsif Has_Aspect (Ptyp, Aspect_Iterable) then
declare
Element : constant Entity_Id :=
Get_Iterable_Type_Primitive
(Ptyp, Name_Element);
begin
if Present (Element) then
Accum_Typ := Etype (Element);
end if;
end;
else
declare
Element : constant Node_Id :=
Find_Value_Of_Aspect
(Ptyp, Aspect_Iterator_Element);
begin
if Present (Element) then
Accum_Typ := Entity (Element);
end if;
end;
end if;
end;
end if;
end;
end if;
@ -6110,10 +6161,11 @@ package body Exp_Attr is
Make_Object_Declaration (Loc,
Defining_Identifier => Bnn,
Object_Definition =>
New_Occurrence_Of (Typ, Loc),
New_Occurrence_Of (Accum_Typ, Loc),
Expression => Relocate_Node (E2)), New_Loop),
Expression => New_Occurrence_Of (Bnn, Loc)));
Analyze_And_Resolve (N, Typ);
Analyze_And_Resolve (N, Accum_Typ);
end;
----------