This is a regression recently introduced by the rewrite of the resolution of
reduction expressions. The resolution of the prefix to an array type built on
the fly when it is an aggregate does not work properly, so this removes it to
get back to the previous working state. This requires performing the full
resolution of the reducer even if it is not overloaded to avoid losing errors
in some illegal cases.
Tested on x86-64/Linux, applied on the mainline.
2026-07-17 Eric Botcazou <[email protected]>
* sem_attr.adb (Resolve_Attribute) <Attribute_Reduce>: Perform the
full resolution of the reducer even if it is not overloaded, but do
not resolve the prefix if it is an aggregate
--
Eric Botcazoudiff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 695b1140a1f..7ef0145e872 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -13198,11 +13198,6 @@ package body Sem_Attr is
function Is_Reducer_Subprogram (E : Entity_Id) return Boolean;
-- Return whether E is a reducer subprogram (RM 4.5.10(11-13))
- function Make_Array_Type
- (Index, Value : Entity_Id) return Entity_Id;
- -- This function returns a simple array type to resolve the
- -- array aggregate.
-
-----------------------
-- Get_Value_Subtype --
-----------------------
@@ -13234,6 +13229,10 @@ package body Sem_Attr is
It : Interp;
begin
+ if not Is_Overloaded (Reducer_N) then
+ return;
+ end if;
+
Get_First_Interp (Reducer_N, I, It);
while Present (It.Nam) loop
if Is_Reducer_Subprogram (It.Nam) then
@@ -13333,22 +13332,6 @@ package body Sem_Attr is
-- Start of processing for Get_Value_Subtype
begin
- -- In case the reducer is not overloaded, check directly
- -- its second formal for the value subtype.
-
- if not Is_Overloaded (Reducer_N) then
- if Is_Reducer_Subprogram (Entity (Reducer_N)) then
- return Etype (Next_Formal
- (First_Formal (Entity (Reducer_N))));
-
- -- Return any type to signal the caller that no proper
- -- reducer subprogram was found.
-
- else
- return Any_Type;
- end if;
- end if;
-
-- RM 4.5.10(11/5): the reducer subprogram is required to be
-- subtype conformant with one of the following profiles:
@@ -13627,31 +13610,6 @@ package body Sem_Attr is
end if;
end Is_Reducer_Subprogram;
- ---------------------
- -- Make_Array_Type --
- ---------------------
-
- function Make_Array_Type
- (Index, Value : Entity_Id) return Entity_Id
- is
- Array_Type : constant Entity_Id := Make_Temporary (Loc, 'A');
- Range_N : constant Node_Id :=
- Make_Range (Loc,
- Low_Bound => Type_Low_Bound (Index),
- High_Bound => Type_High_Bound (Index));
- begin
- Set_In_List (Range_N);
- Set_Etype (Range_N, Index);
-
- Set_Etype (Array_Type, Array_Type);
- Set_Scope (Array_Type, Find_Enclosing_Scope (N));
- Mutate_Ekind (Array_Type, E_Array_Type);
- Set_Component_Type (Array_Type, Value);
- Set_First_Index (Array_Type, Range_N);
-
- return Array_Type;
- end Make_Array_Type;
-
-- Local variables
Reducer_E : Entity_Id;
@@ -13779,15 +13737,13 @@ package body Sem_Attr is
end if;
-- Complete the resolution of the reduction expression by
- -- resolving the initial expression and array aggregate.
+ -- resolving the initial expression, and the prefix if it
+ -- is not an aggregate, since the aggregate is only meant
+ -- to be a placeholder for the iterated association.
Resolve (Init_Value_Expr, Accum_Typ);
- if Nkind (P) = N_Aggregate then
- Resolve_Aggregate (P,
- Make_Array_Type (Index => Standard_Positive,
- Value => Value_Typ));
- else
+ if Nkind (P) /= N_Aggregate then
Resolve (P);
end if;
end;
