[Ada] Fix bogus type mismatch for reduction expression with non-integer index

Message ID 2417504.ElGaqSPkdT@fomalhaut
State New
Headers
Series [Ada] Fix bogus type mismatch for reduction expression with non-integer index |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 fail Patch failed to apply
linaro-tcwg-bot/tcwg_gcc_build--master-arm fail Patch failed to apply
linaro-tcwg-bot/tcwg_simplebootstrap_build--master-aarch64-bootstrap fail Patch failed to apply
linaro-tcwg-bot/tcwg_simplebootstrap_build--master-arm-bootstrap fail Patch failed to apply

Commit Message

Eric Botcazou July 17, 2026, 7:20 a.m. UTC
  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  <ebotcazou@adacore.com>

	* 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
  

Patch

diff --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;