diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2022-02-06 15:54:25 +0100 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-05-12 12:38:34 +0000 |
| commit | b9cff88ca79664ade8bd1c870d01b56f8599afa4 (patch) | |
| tree | b75825bfbbcff457e09b19a7ae2bfa966de4c9db | |
| parent | e845160a0829f66ff65f9a720fa9c4757fa50798 (diff) | |
| download | gcc-b9cff88ca79664ade8bd1c870d01b56f8599afa4.zip gcc-b9cff88ca79664ade8bd1c870d01b56f8599afa4.tar.gz gcc-b9cff88ca79664ade8bd1c870d01b56f8599afa4.tar.bz2 | |
[Ada] Fix remaining asymmetry in Specific_Type
gcc/ada/
* sem_type.adb (Specific_Type): Add swapped cases for interfaces.
| -rw-r--r-- | gcc/ada/sem_type.adb | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index d5ee20b..971b1a31 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -3354,13 +3354,8 @@ package body Sem_Type is elsif T2 = Raise_Type then return B1; - -- ---------------------------------------------------------- - -- Special cases for equality operators (all other predefined - -- operators can never apply to tagged types) - -- ---------------------------------------------------------- - -- Ada 2005 (AI-251): T1 and T2 are class-wide types, and T2 is an - -- interface + -- interface, return T1, and vice versa. elsif Is_Class_Wide_Type (T1) and then Is_Class_Wide_Type (T2) @@ -3368,8 +3363,14 @@ package body Sem_Type is then return T1; + elsif Is_Class_Wide_Type (T2) + and then Is_Class_Wide_Type (T1) + and then Is_Interface (Etype (T1)) + then + return T2; + -- Ada 2005 (AI-251): T1 is a concrete type that implements the - -- class-wide interface T2 + -- class-wide interface T2, return T1, and vice versa. elsif Is_Tagged_Type (T1) and then Is_Class_Wide_Type (T2) @@ -3379,6 +3380,14 @@ package body Sem_Type is then return T1; + elsif Is_Tagged_Type (T2) + and then Is_Class_Wide_Type (T1) + and then Is_Interface (Etype (T1)) + and then Interface_Present_In_Ancestor (Typ => T2, + Iface => Etype (T1)) + then + return T2; + elsif Is_Class_Wide_Type (T1) and then Is_Ancestor (Root_Type (T1), T2) then |