From 198064c06a1e1e85cf498ad42983c5eab1f27c4a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 28 Jan 2020 23:52:17 +0100 Subject: [Ada] Fix a couple of oversights in previous change 2020-06-04 Eric Botcazou gcc/ada/ * exp_ch7.adb (Make_Final_Call): Add missing guard. * sem_ch3.adb (Copy_And_Build): Adjust recursive call for private types. (Build_Derived_Private_Type): Deal with underlying full views. --- gcc/ada/exp_ch7.adb | 1 + gcc/ada/sem_ch3.adb | 20 ++++++++++++++++---- 2 files changed, 17 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 9d7ed12..fbdef9b 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -8290,6 +8290,7 @@ package body Exp_Ch7 is Ref := Convert_Concurrent (Ref, Typ); elsif Is_Private_Type (Typ) + and then Present (Underlying_Type (Typ)) and then Is_Concurrent_Type (Underlying_Type (Typ)) then Utyp := Corresponding_Record_Type (Underlying_Type (Typ)); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 8d86bc7..56e0aa2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -7735,9 +7735,13 @@ package body Sem_Ch3 is end if; else + -- If the parent type is private, this is not a completion and + -- we build the full derivation recursively as a completion. + Build_Derived_Type (Full_N, Full_Parent, Full_Der, - Is_Completion => False, Derive_Subps => False); + Is_Completion => Is_Private_Type (Full_Parent), + Derive_Subps => False); end if; -- The full declaration has been introduced into the tree and @@ -7925,7 +7929,9 @@ package body Sem_Ch3 is -- case (see point 5. of its head comment) since we build it for the -- derived subtype. - if Present (Full_View (Parent_Type)) + if (Present (Full_View (Parent_Type)) + or else (Present (Underlying_Full_View (Parent_Type)) + and then Is_Completion)) and then not Is_Itype (Derived_Type) then declare @@ -7977,8 +7983,14 @@ package body Sem_Ch3 is end; end if; - elsif Present (Full_View (Parent_Type)) - and then Has_Discriminants (Full_View (Parent_Type)) + elsif (Present (Full_View (Parent_Type)) + and then + Has_Discriminants (Full_View (Parent_Type))) + or else (Present (Underlying_Full_View (Parent_Type)) + and then + Has_Discriminants (Underlying_Full_View (Parent_Type)) + and then + Is_Completion) then if Has_Unknown_Discriminants (Parent_Type) and then Nkind (Subtype_Indication (Type_Definition (N))) = -- cgit v1.1