From: Denis Mazzucato <mazzucato@adacore.com>
Date: Sat, 6 Dec 2025 18:13:26 +0000 (+0100)
Subject: Ada: Fix spurious warning if the reducer subprogram is a procedure
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=55d31324ac5c2763e9c9eb647c5ec068af24baf3;p=thirdparty%2Fgcc.git

Ada: Fix spurious warning if the reducer subprogram is a procedure

If the reducer is a function and the accumulator type isn't constrained,
at runtime the reduction will likely raise a Constraint_Error since the
reducer is repeatedly assigned to the accumulator variable (likely changing
its length). However, if the reducer is a procedure, no such assignment
occurs, and thus the runtime error only depends on the reducer logic.
This patch prevents the spurious warning in that case.

gcc/ada/
	* sem_attr.adb (Resolve_Attribute): Check if the reducer is a
	procedure before giving the warning.
---

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index d38e71a01c6..ca19cada29e 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -13204,32 +13204,6 @@ package body Sem_Attr is
                   return;
                end if;
 
-               --  If the Accum_Typ is an unconstrained array then a
-               --  Constraint_Error will be raised at runtime as most
-               --  computations will change its length type during the
-               --  reduction execution, RM 4.5.10(25/5). For instance, this is
-               --  the case with: [...]'Reduce ("&", ...). When the expression
-               --  yields non-empty strings, the reduction repeatedly executes
-               --  the following assignment:
-               --    Acc := Expr (I) & Acc;
-               --  which will raise a Constraint_Error since the number of
-               --  elements is increasing.
-
-               if not Is_Numeric_Type (Base_Type (Accum_Typ))
-                 and then not Is_Constrained (Accum_Typ)
-               then
-                  declare
-                     Discard : Node_Id;
-                     pragma Unreferenced (Discard);
-                  begin
-                     Discard := Compile_Time_Constraint_Error
-                                  (Reducer_N,
-                                   "potential length mismatch!!??",
-                                   Accum_Typ);
-                     return;
-                  end;
-               end if;
-
                --  If no error has been posted and the accumulation type is
                --  constrained, then the resolution of the reducer can start.
 
@@ -13311,6 +13285,33 @@ package body Sem_Attr is
                if Is_Limited_Type (Accum_Typ) then
                   Error_Msg_N
                     ("accumulated subtype of Reduce must be nonlimited", N);
+
+               --  If the Accum_Typ is an unconstrained array and the reducer
+               --  subprogram is a function then a Constraint_Error will be
+               --  raised at runtime as most computations will change its
+               --  length type during the reduction execution, RM 4.5.10(25/5).
+               --  For instance, this is the case with:
+               --    [...]'Reduce ("&", ...)
+               --  When the expression yields non-empty strings, the reduction
+               --  repeatedly executes the following assignment:
+               --    Acc := Expr (I) & Acc;
+               --  which will raise a Constraint_Error since the number of
+               --  elements is increasing.
+
+               elsif Nkind (Reducer_E) /= N_Attribute_Reference
+                 and then Ekind (Reducer_E) = E_Function
+                 and then not Is_Numeric_Type (Base_Type (Accum_Typ))
+                 and then not Is_Constrained (Accum_Typ)
+               then
+                  declare
+                     Discard : Node_Id;
+                     pragma Unreferenced (Discard);
+                  begin
+                     Discard := Compile_Time_Constraint_Error
+                                  (Reducer_N,
+                                   "potential length mismatch!!??",
+                                   Accum_Typ);
+                  end;
                end if;
 
                --  Complete the resolution of the reduction expression by