[gcc r17-881] ada: Fix bogus visibility error for inherited operator of null extension

[Marc Poulhies]

https://gcc.gnu.org/g:d3b6fc8b78153be235141684900788b7888add58

commit r17-881-gd3b6fc8b78153be235141684900788b7888add58
Author: Eric Botcazou <ebotcazou@adacore.com>
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 0e83b9b5854d..73d37dea315e 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -11693,6 +11693,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 dfcf384c7dae..f69e7959ee52 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 --
    -------------------------------
@@ -2433,6 +2441,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