From: Eric Botcazou <ebotcazou@adacore.com>
Date: Sat, 3 Feb 2024 11:59:16 +0000 (+0100)
Subject: Revert fix for reduction expression with overloaded reducer subprogram
X-Git-Tag: releases/gcc-13.3.0~506
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=58ffc0f066731786a11c4bee8217c71c4949262e;p=thirdparty%2Fgcc.git

Revert fix for reduction expression with overloaded reducer subprogram

gcc/ada
	* exp_attr.adb (Expand_N_Attribute_Reference): Revert latest change.
---

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 2aac1063cc51..7e71422eba3b 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5982,7 +5982,7 @@ package body Exp_Attr is
             E2  : constant Node_Id    := Next (E1);
             Bnn : constant Entity_Id  := Make_Temporary (Loc, 'B', N);
 
-            Accum_Typ : Entity_Id := Empty;
+            Accum_Typ : Entity_Id;
             New_Loop  : Node_Id;
 
             function Build_Stat (Comp : Node_Id) return Node_Id;
@@ -6001,6 +6001,7 @@ package body Exp_Attr is
 
             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,
@@ -6011,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,
@@ -6077,9 +6080,12 @@ package body Exp_Attr is
                       Statements =>
                         New_List (Build_Stat (Relocate_Node (Expr))));
 
-                  --  Look at the context to find the type.
+                  --  If the reducer subprogram is a universal operator, then
+                  --  we still look at the context to find the type for now.
 
-                  Accum_Typ := Etype (N);
+                  if Is_Universal_Numeric_Type (Accum_Typ) then
+                     Accum_Typ := Etype (N);
+                  end if;
                end;
 
             else
@@ -6109,40 +6115,43 @@ 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
+                  --  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.
 
-                  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;
+                  if Is_Universal_Numeric_Type (Accum_Typ) then
+                     declare
+                        Ptyp : constant Entity_Id :=
+                                 Base_Type (Etype (Prefix (N)));
 
-                     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;
+                     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;