https://gcc.gnu.org/g:c1d8092aa8c12ef901c84734a8a8fe10155f58aa
commit r16-9192-gc1d8092aa8c12ef901c84734a8a8fe10155f58aa 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 93aa84403b0d..a10061f63200 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6266,7 +6266,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; ------------------------ @@ -6920,11 +6920,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 @@ -6946,14 +6948,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 5cd6d81bcb4f..f90ee03d5440 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -651,7 +651,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 e89520dfddd3..75c6bf0c95f1 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -17926,6 +17926,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;
