diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2020-01-27 12:50:23 +0100 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-04 05:11:14 -0400 |
| commit | a3fbeceef46546fd47ed370474feed347c86713f (patch) | |
| tree | 3015c5813fab3c0ec7c43afc94c210421a8aa4c2 /gcc/ada/exp_tss.adb | |
| parent | e5e53c73a0cf2e326bbfdacbe94e4a3bb79cd219 (diff) | |
| download | gcc-a3fbeceef46546fd47ed370474feed347c86713f.zip gcc-a3fbeceef46546fd47ed370474feed347c86713f.tar.gz gcc-a3fbeceef46546fd47ed370474feed347c86713f.tar.bz2 | |
[Ada] Alignment clause ignored on completion derived from private type
2020-06-04 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* exp_attr.adb (xpand_N_Attribute_Reference) <Input>: Call
Find_Inherited_TSS to look up the Stream_Read TSS.
<Output>: Likewise for the Stream_Write TSS.
* exp_ch7.adb (Make_Final_Call): Call Underlying_Type on
private types to account for underlying full views.
* exp_strm.ads (Build_Record_Or_Elementary_Input_Function):
Remove Use_Underlying parameter.
* exp_strm.adb (Build_Record_Or_Elementary_Input_Function):
Likewise and adjust accordingly.
* exp_tss.adb (Find_Inherited_TSS): Deal with full views.
Call Find_Inherited_TSS recursively on the parent type if
the base type is a derived type.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Take
into account underlying full views for derived types.
* sem_ch3.adb (Copy_And_Build): Look up the underlying full
view only for a completion. Be prepared for private types.
(Build_Derived_Private_Type): Build an underlying full view
for a completion in the general case too.
Diffstat (limited to 'gcc/ada/exp_tss.adb')
| -rw-r--r-- | gcc/ada/exp_tss.adb | 26 |
1 files changed, 14 insertions, 12 deletions
diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index d00197f..fc2338f 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.adb @@ -147,27 +147,29 @@ package body Exp_Tss is (Typ : Entity_Id; Nam : TSS_Name_Type) return Entity_Id is - Btyp : Entity_Id := Typ; + Btyp : Entity_Id; Proc : Entity_Id; begin - loop - Btyp := Base_Type (Btyp); - Proc := TSS (Btyp, Nam); + -- If Typ is a private type, look at the full view - exit when Present (Proc) - or else not Is_Derived_Type (Btyp); + if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then + Btyp := Base_Type (Full_View (Typ)); + else + Btyp := Base_Type (Typ); + end if; - -- If Typ is a derived type, it may inherit attributes from some - -- ancestor. + Proc := TSS (Btyp, Nam); - Btyp := Etype (Btyp); - end loop; + -- If Typ is a derived type, it may inherit attributes from an ancestor - if No (Proc) then + if No (Proc) and then Is_Derived_Type (Btyp) then + Proc := Find_Inherited_TSS (Etype (Btyp), Nam); + end if; - -- If nothing else, use the TSS of the root type + -- If nothing else, use the TSS of the root type + if No (Proc) then Proc := TSS (Base_Type (Underlying_Type (Typ)), Nam); end if; |