[Ada] Wording problems with predicates (AI12-0099)

Message ID 20200706113854.GA135391@adacore.com
State New
Headers show
Series
  • [Ada] Wording problems with predicates (AI12-0099)
Related show

Commit Message

Pierre-Marie de Rodat July 6, 2020, 11:38 a.m.
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.

Patch

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