aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2024-04-26 18:22:19 +0000
committerMarc Poulhiès <poulhies@adacore.com>2024-06-13 15:30:31 +0200
commit5c45881bf57fa1ae593b5cab8f4db67506470ff9 (patch)
treedd46f774cd34c3b04192b60fd420557151c25a25
parent63bf005b2f5047841730b1ba4ca0799c471f75d1 (diff)
downloadgcc-5c45881bf57fa1ae593b5cab8f4db67506470ff9.zip
gcc-5c45881bf57fa1ae593b5cab8f4db67506470ff9.tar.gz
gcc-5c45881bf57fa1ae593b5cab8f4db67506470ff9.tar.bz2
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.
-rw-r--r--gcc/ada/sem_ch4.adb23
1 files changed, 22 insertions, 1 deletions
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 03364da..b59a56c 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