diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 63b311c1b89010473fb68d266600bb02a52e28a3..809116d89e3f498546a6bde56fbed8c9cb97fd44 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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;