[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 --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 509c6047d22b54186ca488f9de7167154ae21f61..77f212c2c157141087c6961574d66abecb7024dc 100644 (file)
--- 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 5318fc6160328e9b337e7b55bf54062f97362343..c6a26146868665b70e412bfef10ef5d3e7af6964 100644 (file)
--- 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