diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-04-09 09:35:24 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-04-09 09:35:24 +0000 |
| commit | f301a57be311b6929347c09364cdc2ac05759729 (patch) | |
| tree | 3ab08bc8a192f550642f5ccee3b8b0402ffdf1cf /gcc/ada/sem_util.adb | |
| parent | d70d22d5709ec81d325fa38c103db443d4c12d4a (diff) | |
| download | gcc-f301a57be311b6929347c09364cdc2ac05759729.tar.gz | |
2009-04-09 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Export_DT): Addition of a new argument (Index); used to
retrieve from the Dispatch_Table_Wrappers list the external name.
Addition of documentation.
(Make_Secondary_DT): Addition of a new argument (Suffix_Index) that is
used to export secondary dispatch tables (in the previous version of
the frontend only primary dispatch tables were exported). Addition of
documentation.
(Import_DT): New subprogram (internal of Make_Tags). Used to import a
dispatch table of a given tagged type.
(Make_Tags): Modified to import secondary dispatch tables.
* sem_ch3.adb (Analyze_Object_Declaration): Code cleanup.
(Constant_Redeclaration): Code cleanup.
* einfo.ads (Dispatch_Table_Wrapper): Renamed to
Dispatch_Table_Wrappers. Update documentation.
* einfo.adb (Dispatch_Table_Wrapper, Set_Dispatch_Table_Wrapper):
Renamed to Dispatch_Table_Wrappers.
* sem_util.adb (Collect_Interface_Components): Improve handling of
private types.
* atree.ads (Elist26, Set_Elist26): New subprograms
* atree.adb (Elist26, Set_Elist26): New subprograms
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145811 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/sem_util.adb')
| -rw-r--r-- | gcc/ada/sem_util.adb | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b2651553f2e..3f60ebcbedf 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1356,10 +1356,19 @@ package body Sem_Util is ------------- procedure Collect (Typ : Entity_Id) is - Tag_Comp : Entity_Id; + Tag_Comp : Entity_Id; + Parent_Typ : Entity_Id; begin - if Etype (Typ) /= Typ + -- Handle private types + + if Present (Full_View (Etype (Typ))) then + Parent_Typ := Full_View (Etype (Typ)); + else + Parent_Typ := Etype (Typ); + end if; + + if Parent_Typ /= Typ -- Protect the frontend against wrong sources. For example: @@ -1372,9 +1381,9 @@ package body Sem_Util is -- type C is new B with null record; -- end P; - and then Etype (Typ) /= Tagged_Type + and then Parent_Typ /= Tagged_Type then - Collect (Etype (Typ)); + Collect (Parent_Typ); end if; -- Collect the components containing tags of secondary dispatch |