diff options
| author | Bob Duff <duff@adacore.com> | 2008-05-27 14:36:23 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2008-05-27 14:36:23 +0200 |
| commit | d33fb1e6debbc2ae26e323685fd9ce321ba65418 (patch) | |
| tree | 8104c2a196c4475cd68d877387cf3f4fc233987f | |
| parent | 592b9a75fcfc1c857eb7f085bd9eec541262ed68 (diff) | |
| download | gcc-d33fb1e6debbc2ae26e323685fd9ce321ba65418.zip gcc-d33fb1e6debbc2ae26e323685fd9ce321ba65418.tar.gz gcc-d33fb1e6debbc2ae26e323685fd9ce321ba65418.tar.bz2 | |
sem_ch3.adb (Build_Incomplete_Type_Declaration): In the case of an untagged private type with a tagged full type...
2008-05-27 Bob Duff <duff@adacore.com>
* sem_ch3.adb (Build_Incomplete_Type_Declaration): In the case of an
untagged private type with a tagged full type, where the full type has
a self reference, create the corresponding class-wide type early, in
case the self reference is "access T'Class".
From-SVN: r136025
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 35 |
1 files changed, 26 insertions, 9 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a375eed..4f61821 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -16619,7 +16619,8 @@ package body Sem_Ch3 is -- view of the type. function Designates_T (Subt : Node_Id) return Boolean; - -- Check whether a node designates the enclosing record type + -- Check whether a node designates the enclosing record type, or 'Class + -- of that type function Mentions_T (Acc_Def : Node_Id) return Boolean; -- Check whether an access definition includes a reference to @@ -16637,13 +16638,25 @@ package body Sem_Ch3 is Inc_T : Entity_Id; H : Entity_Id; + -- Is_Tagged indicates whether the type is tagged. It is tagged if + -- it's "is new ... with record" or else "is tagged record ...". + + Is_Tagged : constant Boolean := + (Nkind (Type_Definition (Typ_Decl)) = N_Derived_Type_Definition + and then + Present + (Record_Extension_Part (Type_Definition (Typ_Decl)))) + or else + (Nkind (Type_Definition (Typ_Decl)) = N_Record_Definition + and then Tagged_Present (Type_Definition (Typ_Decl))); + begin -- If there is a previous partial view, no need to create a new one -- If the partial view, given by Prev, is incomplete, If Prev is -- a private declaration, full declaration is flagged accordingly. if Prev /= Typ then - if Tagged_Present (Type_Definition (Typ_Decl)) then + if Is_Tagged then Make_Class_Wide_Type (Prev); Set_Class_Wide_Type (Typ, Class_Wide_Type (Prev)); Set_Etype (Class_Wide_Type (Typ), Typ); @@ -16652,6 +16665,15 @@ package body Sem_Ch3 is return; elsif Has_Private_Declaration (Typ) then + + -- If we refer to T'Class inside T, and T is the completion of a + -- private type, then we need to make sure the class-wide type + -- exists. + + if Is_Tagged then + Make_Class_Wide_Type (Typ); + end if; + return; -- If there was a previous anonymous access type, the incomplete @@ -16693,14 +16715,9 @@ package body Sem_Ch3 is Analyze (Decl); Set_Full_View (Inc_T, Typ); - if (Nkind (Type_Definition (Typ_Decl)) = N_Derived_Type_Definition - and then - Present - (Record_Extension_Part (Type_Definition (Typ_Decl)))) - or else Tagged_Present (Type_Definition (Typ_Decl)) - then + if Is_Tagged then -- Create a common class-wide type for both views, and set - -- the etype of the class-wide type to the full view. + -- the Etype of the class-wide type to the full view. Make_Class_Wide_Type (Inc_T); Set_Class_Wide_Type (Typ, Class_Wide_Type (Inc_T)); |