From 20643f5032f7f3c11a233861e05f8efb4059e9dd Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 11 Jun 2018 09:19:02 +0000 Subject: [Ada] Missing predicate function body for derived type in nested package This patch fixes a bug in the construction of predicate functions. For a derived type, we must ensure that the parent type is already frozen so that its predicate function has been constructed already. This is necessary if the parent is declared in a nested package and its own freeze point has not been reached when the derived type is frozen by a local object declaration. 2018-06-11 Ed Schonberg gcc/ada/ * sem_ch13.adb (Build_Predicate_Functions): For a derived type, ensure that its parent is already frozen so that its predicate function, if any, has already been constructed. gcc/testsuite/ * gnat.dg/predicate1.adb: New testcase. From-SVN: r261422 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_ch13.adb | 16 +++++++++++++++- 2 files changed, 21 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 175d15d..2393bfa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-06-11 Ed Schonberg + + * sem_ch13.adb (Build_Predicate_Functions): For a derived type, ensure + that its parent is already frozen so that its predicate function, if + any, has already been constructed. + 2018-06-11 Yannick Moy * sem_prag.adb (Check_Mode_Restriction_In_Enclosing_Context): Adapt for diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index efa2709..ad9e9a1 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11114,13 +11114,27 @@ package body Sem_Ch13 is -- If we have a type with predicates, build predicate function. This is -- not needed in the generic case, nor within TSS subprograms and other - -- predefined primitives. + -- predefined primitives. For a derived type, ensure that the parent + -- type is already frozen so that its predicate function has been + -- constructed already. This is necessary if the parent is declared + -- in a nested package and its own freeze point has not been reached. if Is_Type (E) and then Nongeneric_Case and then not Within_Internal_Subprogram and then Has_Predicates (E) then + declare + Atyp : constant Entity_Id := Nearest_Ancestor (E); + begin + if Present (Atyp) + and then Has_Predicates (Atyp) + and then not Is_Frozen (Atyp) + then + Freeze_Before (N, Atyp); + end if; + end; + Build_Predicate_Functions (E, N); end if; -- cgit v1.1