https://gcc.gnu.org/g:b56a3551dde1c743e400f8432d1323883516b5cf
commit r17-1964-gb56a3551dde1c743e400f8432d1323883516b5cf Author: Eric Botcazou <[email protected]> Date: Tue Jun 16 11:27:29 2026 +0200 ada: Fix wrong error message with Finalizable and overloading We accept overloading for the primitives denoted by the Finalizable aspect, so Find_Controlled_Prim_Op needs to filter out the unrelated primitives. gcc/ada/ChangeLog: * exp_util.ads (Find_Optional_Prim_Op): Add Controlled_Op parameter defaulting to False. * exp_util.adb (Find_Optional_Prim_Op): Likewise. When it is set to True, test whether the primitive has the signature of the controlled primitives. * sem_ch13.adb (Resolve_Finalization_Procedure): Reset Is_Overloaded once an interpretation has been selected among the set. Diff: --- gcc/ada/exp_util.adb | 25 ++++++++++++++++++------- gcc/ada/exp_util.ads | 8 +++++++- gcc/ada/sem_ch13.adb | 1 + 3 files changed, 26 insertions(+), 8 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 7a19c6c1d045..f4bcd18dab75 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6393,7 +6393,7 @@ package body Exp_Util is return Empty; end if; - return Find_Optional_Prim_Op (T, Op_Name); + return Find_Optional_Prim_Op (T, Op_Name, Controlled_Op => True); end Find_Controlled_Prim_Op; ------------------------ @@ -7047,11 +7047,13 @@ package body Exp_Util is --------------------------- function Find_Optional_Prim_Op - (T : Entity_Id; Name : Name_Id) return Entity_Id + (T : Entity_Id; + Name : Name_Id; + Controlled_Op : Boolean := False) return Entity_Id is + Op : Entity_Id; Prim : Elmt_Id; Typ : Entity_Id := T; - Op : Entity_Id; begin if Is_Class_Wide_Type (Typ) then @@ -7073,14 +7075,23 @@ package body Exp_Util is Op := Node (Prim); -- We can retrieve primitive operations by name if it is an internal - -- name. For equality we must check that both of its operands have - -- the same type, to avoid confusion with user-defined equalities - -- than may have a asymmetric signature. + -- name. For equality, we must check that both of its operands have + -- the same type, to avoid confusion with user-defined equalities, + -- which may have an asymmetric signature. For controlled operations, + -- we check that the primitive is a procedure with a single In Out + -- parameter of a non-access type. exit when Chars (Op) = Name and then (Name /= Name_Op_Eq - or else Etype (First_Formal (Op)) = Etype (Last_Formal (Op))); + or else Etype (First_Formal (Op)) = Etype (Last_Formal (Op))) + and then + (not Controlled_Op + or else + (Ekind (Op) = E_Procedure + and then Ekind (First_Formal (Op)) = E_In_Out_Parameter + and then not Is_Access_Type (Etype (First_Formal (Op))) + and then No (Next_Formal (First_Formal (Op))))); Next_Elmt (Prim); end loop; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index f8118b76424c..91f5ec85f0a4 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -672,7 +672,13 @@ package Exp_Util is -- although they are not master constructs in the language. function Find_Optional_Prim_Op - (T : Entity_Id; Name : Name_Id) return Entity_Id; + (T : Entity_Id; + Name : Name_Id; + Controlled_Op : Boolean := False) return Entity_Id; + -- Same as Find_Prim_Op but, if Controlled_Op is True, returns a primitive + -- only if it has the signature of the three primitives of controlled types + -- Initialize/Adjust/Finalize, and returns Empty if not found. + function Find_Optional_Prim_Op (T : Entity_Id; Name : TSS_Name_Type) return Entity_Id; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e2be25928701..b2845814d306 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -18013,6 +18013,7 @@ package body Sem_Ch13 is while Present (It.Typ) loop if Is_Finalizable_Primitive (It.Nam) then Set_Entity (N, It.Nam); + Set_Is_Overloaded (N, False); return True; end if;
