[gcc r15-1274] ada: Interfaces order disables class-wide prefix notation calls

[Marc Poulhi?s]

https://gcc.gnu.org/g:5c45881bf57fa1ae593b5cab8f4db67506470ff9

commit r15-1274-g5c45881bf57fa1ae593b5cab8f4db67506470ff9
Author: Javier Miranda <miranda@adacore.com>
Date:   Fri Apr 26 18:22:19 2024 +0000

    ada: Interfaces order disables class-wide prefix notation calls
    
    When the first formal parameter of a subprogram is a class-wide
    interface type (or an access to a class-wide interface type),
    changing the order of the interface types implemented by a
    type declaration T enables or disables the ability to use the
    prefix notation to call it with objects of type T. When the
    call is disabled the compiler rejects it reporting an error.
    
    gcc/ada/
    
            * sem_ch4.adb (Traverse_Interfaces): Add missing support
            for climbing to parents of interface types.

Diff:
---
 gcc/ada/sem_ch4.adb | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 03364dade9f6..b59a56c139b9 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -9805,11 +9805,23 @@ package body Sem_Ch4 is
          begin
             Error := False;
 
+            --  When climbing through the parents of an interface type,
+            --  look for acceptable class-wide homonyms associated with
+            --  the interface type.
+
+            if Is_Interface (Anc_Type) then
+               Traverse_Homonyms (Anc_Type, Error);
+
+               if Error then
+                  return;
+               end if;
+            end if;
+
             Intface := First (Intface_List);
             while Present (Intface) loop
 
                --  Look for acceptable class-wide homonyms associated with the
-               --  interface.
+               --  interface type.
 
                Traverse_Homonyms (Etype (Intface), Error);
 
@@ -9828,6 +9840,15 @@ package body Sem_Ch4 is
 
                Next (Intface);
             end loop;
+
+            --  For derived interface types continue the search climbing to
+            --  the parent type.
+
+            if Is_Interface (Anc_Type)
+              and then Etype (Anc_Type) /= Anc_Type
+            then
+               Traverse_Interfaces (Etype (Anc_Type), Error);
+            end if;
          end Traverse_Interfaces;
 
       --  Start of processing for Try_Class_Wide_Operation