From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 21 Dec 2020 01:18:33 +0000 (-0500)
Subject: [Ada] Compiler aborts on a constrained subtype of a predicated type
X-Git-Tag: basepoints/gcc-13~7965
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=03c80e174bc059b50063da24cf89b67e692bc5d8;p=thirdparty%2Fgcc.git

[Ada] Compiler aborts on a constrained subtype of a predicated type

gcc/ada/

	* sem_util.adb (Build_Constrained_Itype): Remove prior patch,
	issue is better handled in Sem_Ch13.Build_Predicate_Functions.
	* sem_ch13.adb (Build_Predicate_Functions): Do not build
	predicate function for an Itype with a defined
	Predicated_Parent, even if that designated parent does not yet
	have a Predicate_Function. This can happen in instance bodies
	nested within a generic unit.
---

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index c8631545815d..005c7b0cf508 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -9976,11 +9976,23 @@ package body Sem_Ch13 is
    --  Start of processing for Build_Predicate_Functions
 
    begin
-      --  Return if already built or if type does not have predicates
+      --  Return if already built, if type does not have predicates,
+      --  or if type is a constructed subtype that will inherit a
+      --  predicate function from its ancestor. In a generic context
+      --  the predicated parent may not have a predicate function yet
+      --  but we don't want to build a new one for the subtype. This can
+      --  happen in an instance body which is nested within a generic
+      --  unit, in which case Within_A_Generic may be false, SId is
+      --  Empty, but uses of Typ will receive a predicate check in a
+      --  context where expansion and tests are enabled.
 
       SId := Predicate_Function (Typ);
       if not Has_Predicates (Typ)
         or else (Present (SId) and then Has_Completion (SId))
+        or else
+          (Is_Itype (Typ)
+           and then not Comes_From_Source (Typ)
+           and then Present (Predicated_Parent (Typ)))
       then
          return;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a64cbde17edf..b7b622dbcca9 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2380,14 +2380,6 @@ package body Sem_Util is
 
       Analyze (Subtyp_Decl, Suppress => All_Checks);
 
-      --  In addition, inhibit the generation of predicate functions for
-      --  this subtype, because its declaration is not in a declarative
-      --  list, and no predicates apply to the aggregate itself, but only
-      --  to the object to which it may be assigned.
-
-      Set_Has_Dynamic_Predicate_Aspect (Def_Id, False);
-      Set_Has_Predicates (Def_Id, False);
-
       Set_Etype (N, Def_Id);
    end Build_Constrained_Itype;