[gcc/devel/c++-modules] [Ada] Wording problems with predicates (AI12-0099)

[gcc/devel/c++-modules] [Ada] Wording problems with predicates (AI12-0099)

[Nathan Sidwell]

https://gcc.gnu.org/g:60e010e7f39b10bbc8e8b5d8a956335c5b42b39e

commit 60e010e7f39b10bbc8e8b5d8a956335c5b42b39e
Author: Gary Dismukes <dismukes@adacore.com>
Date:   Sun May 3 18:45:37 2020 -0400

    [Ada] Wording problems with predicates (AI12-0099)
    
    gcc/ada/
    
            * sem_aux.adb: Add a with clause for Nlists.
            (Nearest_Ancestor): Test for the case of concurrent
            types (testing for both Is_Concurrent_Type and
            Is_Concurrent_Record_Type), and return the first ancestor in the
            Interfaces list if present (otherwise will return Empty if no
            interfaces).
            * sem_ch13.adb (Build_Predicate_Functions): Add a ??? comment
            about missing handling for adding predicates when they can be
            inherited from multiple progenitors.

Diff:
---
 gcc/ada/sem_aux.adb  | 13 +++++++++++++
 gcc/ada/sem_ch13.adb |  3 +++
 2 files changed, 16 insertions(+)

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 509c6047d22..77f212c2c15 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -32,6 +32,7 @@
 
 with Atree;  use Atree;
 with Einfo;  use Einfo;
+with Nlists; use Nlists;
 with Snames; use Snames;
 with Stand;  use Stand;
 with Uintp;  use Uintp;
@@ -1375,6 +1376,18 @@ package body Sem_Aux is
             end if;
          end;
 
+      --  If this is a concurrent declaration with a nonempty interface list,
+      --  get the first progenitor. Account for case of a record type created
+      --  for a concurrent type (which is the only case that seems to occur
+      --  in practice).
+
+      elsif Nkind (D) = N_Full_Type_Declaration
+        and then (Is_Concurrent_Type (Defining_Identifier (D))
+                   or else Is_Concurrent_Record_Type (Defining_Identifier (D)))
+        and then Is_Non_Empty_List (Interface_List (Type_Definition (D)))
+      then
+         return Entity (First (Interface_List (Type_Definition (D))));
+
       --  If derived type and private type, get the full view to find who we
       --  are derived from.
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 5318fc61603..c6a26146868 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -9584,6 +9584,9 @@ package body Sem_Ch13 is
       --  Add predicates for ancestor if present. These must come before the
       --  ones for the current type, as required by AI12-0071-1.
 
+      --  Looks like predicates aren't added for case of inheriting from
+      --  multiple progenitors???
+
       declare
          Atyp : Entity_Id;
       begin