https://gcc.gnu.org/g:5c281418ba3a17e9009445355b011729ea9441c0
commit r15-11329-g5c281418ba3a17e9009445355b011729ea9441c0 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 1b6a0899cc7c..0077421a9a22 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6124,7 +6124,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; ------------------------ @@ -6631,11 +6631,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 @@ -6657,14 +6659,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 4226fcc93777..69e50222a655 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -645,7 +645,13 @@ package Exp_Util is -- and returns Empty if not found. 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 d6206b8341ea..72e24b8b743a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -16930,6 +16930,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; end if;
