https://gcc.gnu.org/g:504c53356bbca5c813aafbca2b79daa037b47a72
commit r16-9007-g504c53356bbca5c813aafbca2b79daa037b47a72 Author: Eric Botcazou <[email protected]> Date: Wed Mar 4 14:36:13 2026 +0100 ada: Fix bogus visibility error for inherited operator of null extension This occurs when the operator has a heterogeneous profile and the extension is declared in the same scope as the type of a non-controlling parameter of the operator, because Find_Dispatching_Type incorrectly returns this type. gcc/ada/ChangeLog: * exp_ch3.adb (Make_Controlling_Function_Wrappers): Manually set the Has_Controlling_Result flag on the wrappers. * sem_disp.ads (Override_Dispatching_Operation): Move to... * sem_disp.adb (Override_Dispatching_Operation): ...here. (Find_Dispatching_Type): Return the (controlling) result type for a controlling function wrapper. Diff: --- gcc/ada/exp_ch3.adb | 1 + gcc/ada/sem_disp.adb | 16 ++++++++++++++++ gcc/ada/sem_disp.ads | 8 -------- 3 files changed, 17 insertions(+), 8 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 6437441e02b5..f419dd3919a0 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -11721,6 +11721,7 @@ package body Exp_Ch3 is Func_Id := Defining_Unit_Name (Specification (Func_Decl)); Mutate_Ekind (Func_Id, E_Function); + Set_Has_Controlling_Result (Func_Id); Set_Is_Wrapper (Func_Id); -- Corresponding_Spec will be set again to the same value during diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 160f1a315751..26ea5ea685c8 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -96,6 +96,14 @@ package body Sem_Disp is -- Check whether a primitive operation is inherited from an operation -- declared in the visible part of its package. + procedure Override_Dispatching_Operation + (Tagged_Type : Entity_Id; + Prev_Op : Entity_Id; + New_Op : Entity_Id); + -- Replace an implicit dispatching operation of the type Tagged_Type + -- with an explicit one. Prev_Op is an inherited primitive operation which + -- is overridden by the explicit declaration of New_Op. + ------------------------------- -- Add_Dispatching_Operation -- ------------------------------- @@ -2436,6 +2444,14 @@ package body Sem_Disp is return Empty; end if; + -- Deal with controlling function wrappers + + elsif Ekind (Subp) = E_Function + and then Has_Controlling_Result (Subp) + and then Is_Wrapper (Subp) + then + return Check_Controlling_Type (Etype (Subp), Subp); + -- General case else diff --git a/gcc/ada/sem_disp.ads b/gcc/ada/sem_disp.ads index f1bf4c4ded98..31a5824bfbb6 100644 --- a/gcc/ada/sem_disp.ads +++ b/gcc/ada/sem_disp.ads @@ -173,14 +173,6 @@ package Sem_Disp is -- controlling operands are also indeterminate. Such a function call may -- inherit a tag from an enclosing call. - procedure Override_Dispatching_Operation - (Tagged_Type : Entity_Id; - Prev_Op : Entity_Id; - New_Op : Entity_Id); - -- Replace an implicit dispatching operation of the type Tagged_Type - -- with an explicit one. Prev_Op is an inherited primitive operation which - -- is overridden by the explicit declaration of New_Op. - procedure Propagate_Tag (Control : Node_Id; Actual : Node_Id); -- If a function call given by Actual is tag-indeterminate, its controlling -- argument is found in the context, given by Control: either from an
