@@ -24,7 +24,6 @@
------------------------------------------------------------------------------
with Accessibility; use Accessibility;
-with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
@@ -6013,6 +6012,7 @@ package body Exp_Attr is
begin
if Nkind (E1) = N_Attribute_Reference then
+ Accum_Typ := Base_Type (Entity (Prefix (E1)));
Stat := Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Bnn, Loc),
Expression => Make_Attribute_Reference (Loc,
@@ -6023,12 +6023,15 @@ 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,
@@ -6038,6 +6041,28 @@ package body Exp_Attr is
Comp)));
end if;
+ -- Try to cope if E1 is wrong because it is an overloaded
+ -- subprogram that happens to be the first candidate
+ -- on a homonym chain, but that resolution candidate turns
+ -- out to be the wrong one.
+ -- This workaround usually gets the right type, but it can
+ -- yield the wrong subtype of that type.
+
+ if Base_Type (Accum_Typ) /= Base_Type (Etype (N)) then
+ Accum_Typ := Etype (N);
+ end if;
+
+ -- Try to cope with wrong E1 when Etype (N) doesn't help
+ if Is_Universal_Numeric_Type (Accum_Typ) then
+ if Is_Array_Type (Etype (Prefix (N))) then
+ Accum_Typ := Component_Type (Etype (Prefix (N)));
+ else
+ -- Further hackery can be added here when there is a
+ -- demonstrated need.
+ null;
+ end if;
+ end if;
+
return Stat;
end Build_Stat;
@@ -6088,10 +6113,6 @@ package body Exp_Attr is
End_Label => Empty,
Statements =>
New_List (Build_Stat (Relocate_Node (Expr))));
-
- -- Look at the context to find the type.
-
- Accum_Typ := Etype (N);
end;
else
@@ -6121,40 +6142,6 @@ package body Exp_Attr is
Statements => New_List (
Build_Stat (New_Occurrence_Of (Elem, Loc))));
- -- Look at the prefix to find the type. This is
- -- modeled on Analyze_Iterator_Specification in Sem_Ch5.
-
- 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;
end if;
From: Steve Baird <baird@adacore.com> There was an earlier bug in determining the accumulator subtype for a reduction expression in the case where the reducer subprogram is overloaded. The fix for that bug introduced a recently-discovered regression. Redo accumulator subtype computation in order to address this regression while preserving the benefits of the earlier fix. gcc/ada/ * exp_attr.adb: Move computation of Accum_Typ entirely into the function Build_Stat. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_attr.adb | 65 ++++++++++++++++++-------------------------- 1 file changed, 26 insertions(+), 39 deletions(-)