diff options
Diffstat (limited to 'gcc/ada/sem_aggr.adb')
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 35 |
1 files changed, 23 insertions, 12 deletions
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d16b7d6b8c4..13ab96c6c63 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2155,20 +2155,31 @@ package body Sem_Aggr is begin Imm_Type := Base_Type (Typ); - while Is_Derived_Type (Imm_Type) - and then Etype (Imm_Type) /= Base_Type (A_Type) - loop - Imm_Type := Etype (Base_Type (Imm_Type)); + while Is_Derived_Type (Imm_Type) loop + if Etype (Imm_Type) = Base_Type (A_Type) then + return True; + + -- The base type of the parent type may appear as a private + -- extension if it is declared as such in a parent unit of + -- the current one. For consistency of the subsequent analysis + -- use the partial view for the ancestor part. + + elsif Is_Private_Type (Etype (Imm_Type)) + and then Present (Full_View (Etype (Imm_Type))) + and then Base_Type (A_Type) = Full_View (Etype (Imm_Type)) + then + A_Type := Etype (Imm_Type); + return True; + + else + Imm_Type := Etype (Base_Type (Imm_Type)); + end if; end loop; - if not Is_Derived_Type (Base_Type (Typ)) - or else Etype (Imm_Type) /= Base_Type (A_Type) - then - Error_Msg_NE ("expect ancestor type of &", A, Typ); - return False; - else - return True; - end if; + -- If previous loop did not find a proper ancestor, report error. + + Error_Msg_NE ("expect ancestor type of &", A, Typ); + return False; end Valid_Ancestor_Type; -- Start of processing for Resolve_Extension_Aggregate |