AI12-0099 corrects the RM wording for two issues. One is that the "not"
operator is allowed in predicate-static expressions, which is already
supported properly by GNAT. The other is that predicates get inherited
in the case of concurrent types that extend from an interface with
a predicate. For the second issue, GNAT was not handling the generation
of the predicate function properly, and left out generation of the body
because it wasn't inheriting a predicate from the ancestor type for
a concurrent type that extends an interface.
Tested on x86_64-pc-linux-gnu, committed on trunk
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
--- 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
--- 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
