diff options
| author | Javier Miranda <miranda@adacore.com> | 2010-10-18 09:59:45 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-18 11:59:45 +0200 |
| commit | ef2a63ba1869942eae7ab3ceb4cada0f025a60ad (patch) | |
| tree | 292fd2cc7ffa00814a3d1bc8bec3ae9dced57607 /gcc/ada/einfo.adb | |
| parent | 6b958cecaa0a9d8cb7b04ee0b4a2e36efd8d0450 (diff) | |
| download | gcc-ef2a63ba1869942eae7ab3ceb4cada0f025a60ad.zip gcc-ef2a63ba1869942eae7ab3ceb4cada0f025a60ad.tar.gz gcc-ef2a63ba1869942eae7ab3ceb4cada0f025a60ad.tar.bz2 | |
einfo.ads, einfo.adb (Primitive_Operations): New synthesized attribute.
2010-10-18 Javier Miranda <miranda@adacore.com>
* einfo.ads, einfo.adb (Primitive_Operations): New synthesized
attribute.
(Direct_Primitive_Operations): Renaming of old Primitive_Operations.
(Set_Direct_Primitive_Operations): Renaming of old
Set_Primitive_Operations. Update documentation
* sem_ch3.adb, exp_util.adb, sem_ch7.adb, sem_ch8.adb, exp_ch3.adb:
Replace occurrences of Set_Primitive_Operations by
Set_Direct_Primitive_Operations.
* sem_cat.adb (Validate_RACW_Primitives): No action needed for tagged
concurrent types.
* exp_dist.adb (Add_RACW_Primitive_Declarations_And_Bodies): Do not
process primitives of concurrent types.
* lib-xref.adb (Generate_Prim_Op_References): Minor code cleanup.
From-SVN: r165618
Diffstat (limited to 'gcc/ada/einfo.adb')
| -rw-r--r-- | gcc/ada/einfo.adb | 35 |
1 files changed, 28 insertions, 7 deletions
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 6782c5b..a8bb4d2 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -121,7 +121,7 @@ package body Einfo is -- Entry_Parameters_Type Node15 -- Extra_Formal Node15 -- Lit_Indexes Node15 - -- Primitive_Operations Elist15 + -- Direct_Primitive_Operations Elist15 -- Related_Instance Node15 -- Scale_Value Uint15 -- Storage_Size_Variable Node15 @@ -817,6 +817,12 @@ package body Einfo is return Uint17 (Id); end Digits_Value; + function Direct_Primitive_Operations (Id : E) return L is + begin + pragma Assert (Is_Tagged_Type (Id)); + return Elist15 (Id); + end Direct_Primitive_Operations; + function Directly_Designated_Type (Id : E) return E is begin pragma Assert (Is_Access_Type (Id)); @@ -2355,8 +2361,16 @@ package body Einfo is function Primitive_Operations (Id : E) return L is begin - pragma Assert (Is_Tagged_Type (Id)); - return Elist15 (Id); + if Is_Concurrent_Type (Id) then + if Present (Corresponding_Record_Type (Id)) then + return Direct_Primitive_Operations + (Corresponding_Record_Type (Id)); + else + return No_Elist; + end if; + else + return Direct_Primitive_Operations (Id); + end if; end Primitive_Operations; function Prival (Id : E) return E is @@ -4817,11 +4831,18 @@ package body Einfo is Set_Node8 (Id, V); end Set_Postcondition_Proc; - procedure Set_Primitive_Operations (Id : E; V : L) is + procedure Set_Direct_Primitive_Operations (Id : E; V : L) is begin - pragma Assert (Is_Tagged_Type (Id)); + pragma Assert + (Is_Tagged_Type (Id) + and then + (Is_Record_Type (Id) + or else + Is_Incomplete_Type (Id) + or else + Ekind_In (Id, E_Private_Type, E_Private_Subtype))); Set_Elist15 (Id, V); - end Set_Primitive_Operations; + end Set_Direct_Primitive_Operations; procedure Set_Prival (Id : E; V : E) is begin @@ -7583,7 +7604,7 @@ package body Einfo is E_Record_Type | E_Record_Subtype | Private_Kind => - Write_Str ("Primitive_Operations"); + Write_Str ("Direct_Primitive_Operations"); when E_Component => Write_Str ("DT_Entry_Count"); |