diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2024-06-04 21:33:28 +0200 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2024-06-21 10:34:20 +0200 |
commit | 7a51065e94e759d20dcb00cf58d4b472cc8185fd (patch) | |
tree | 3d4ffc2312b94a910abf4481d81a13e6109148e2 /gcc | |
parent | 3c99b1a75585b3c5ea5f79c87702c33b60e47a14 (diff) | |
download | gcc-7a51065e94e759d20dcb00cf58d4b472cc8185fd.zip gcc-7a51065e94e759d20dcb00cf58d4b472cc8185fd.tar.gz gcc-7a51065e94e759d20dcb00cf58d4b472cc8185fd.tar.bz2 |
ada: Small cleanup in processing of primitive operations
The processing of primitive operations is now always uniform for tagged and
untagged types, but the code contains left-overs from the time where it was
specific to tagged types, in particular for the handling of subtypes.
gcc/ada/
* einfo.ads (Direct_Primitive_Operations): Mention concurrent types
as well as GNAT extensions instead of implementation details.
(Primitive_Operations): Document that Direct_Primitive_Operations is
also used for concurrent types as a fallback.
* einfo-utils.adb (Primitive_Operations): Tweak formatting.
* exp_util.ads (Find_Prim_Op): Adjust description.
* exp_util.adb (Make_Subtype_From_Expr): In the private case with
unknown discriminants, always copy Direct_Primitive_Operations and
do not overwrite the Class_Wide_Type of the expression's base type.
* sem_ch3.adb (Analyze_Incomplete_Type_Decl): Tweak comment.
(Analyze_Subtype_Declaration): Remove older and now dead calls to
Set_Direct_Primitive_Operations. Tweak comment.
(Build_Derived_Private_Type): Likewise.
(Build_Derived_Record_Type): Likewise.
(Build_Discriminated_Subtype): Set Direct_Primitive_Operations in
all cases instead of just for tagged types.
(Complete_Private_Subtype): Likewise.
(Derived_Type_Declaration): Tweak comment.
* sem_ch4.ads (Try_Object_Operation): Adjust description.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/einfo-utils.adb | 4 | ||||
-rw-r--r-- | gcc/ada/einfo.ads | 34 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 8 | ||||
-rw-r--r-- | gcc/ada/exp_util.ads | 10 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 61 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.ads | 5 |
6 files changed, 55 insertions, 67 deletions
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index 4c86ba1..c0c79f92 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -2422,8 +2422,8 @@ package body Einfo.Utils is begin if Is_Concurrent_Type (Id) then if Present (Corresponding_Record_Type (Id)) then - return Direct_Primitive_Operations - (Corresponding_Record_Type (Id)); + return + Direct_Primitive_Operations (Corresponding_Record_Type (Id)); -- When expansion is disabled, the corresponding record type is -- absent, but if this is a tagged type with ancestors, or if the diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index dd95ea0..de17531 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -932,18 +932,17 @@ package Einfo is -- subtypes. Contains the Digits value specified in the declaration. -- Direct_Primitive_Operations --- Defined in tagged types and subtypes (including synchronized types), --- in tagged private types, and in tagged incomplete types. Moreover, it --- is also defined for untagged types, both when Extensions_Allowed is --- True (-gnatX) to support the extension feature of prefixed calls for --- untagged types, and when Extensions_Allowed is False to get better --- error messages. This field is an element list of entities for --- primitive operations of the type. For incomplete types the list is --- always empty. In order to follow the C++ ABI, entities of primitives --- that come from source must be stored in this list in the order of --- their occurrence in the sources. When expansion is disabled, the --- corresponding record type of a synchronized type is not constructed. --- In that case, such types carry this attribute directly. +-- Defined in concurrent types, tagged record types and subtypes, tagged +-- private types, and tagged incomplete types. Moreover, it is also +-- defined in untagged types, both when GNAT extensions are allowed, to +-- support prefixed calls for untagged types, and when GNAT extensions +-- are not allowed, to give better error messages. Set to a list of +-- entities for primitive operations of the type. For incomplete types +-- the list is always empty. In order to follow the C++ ABI, entities of +-- primitives that come from source must be stored in this list in the +-- order of their occurrence in the sources. When expansion is disabled, +-- the corresponding record type of concurrent types is not constructed; +-- in this case, such types carry this attribute directly. -- Directly_Designated_Type -- Defined in access types. This field points to the type that is @@ -4066,10 +4065,13 @@ package Einfo is -- Primitive_Operations (synthesized) -- Defined in concurrent types, tagged record types and subtypes, tagged --- private types and tagged incomplete types. For concurrent types whose --- Corresponding_Record_Type (CRT) is available, returns the list of --- Direct_Primitive_Operations of its CRT; otherwise returns No_Elist. --- For all the other types returns the Direct_Primitive_Operations. +-- private types, and tagged incomplete types. Moreover, it is also +-- defined in untagged types, both when GNAT extensions are allowed, to +-- support prefixed calls for untagged types, and when GNAT extensions +-- are not allowed, to give better error messages. For concurrent types +-- whose Corresponding_Record_Type (CRT) is available, returns the list +-- of Direct_Primitive_Operations of this CRT. In all the other cases, +-- returns the list of Direct_Primitive_Operations. -- Prival -- Defined in private components of protected types. Refers to the entity diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 7a756af..e86e703 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -10671,12 +10671,8 @@ package body Exp_Util is Set_Is_Itype (Priv_Subtyp); Set_Associated_Node_For_Itype (Priv_Subtyp, E); - if Is_Tagged_Type (Priv_Subtyp) then - Set_Class_Wide_Type - (Base_Type (Priv_Subtyp), Class_Wide_Type (Unc_Typ)); - Set_Direct_Primitive_Operations (Priv_Subtyp, - Direct_Primitive_Operations (Unc_Typ)); - end if; + Set_Direct_Primitive_Operations + (Priv_Subtyp, Direct_Primitive_Operations (Unc_Typ)); Set_Full_View (Priv_Subtyp, Full_Subtyp); diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 16d8e14..6460bf02 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -578,11 +578,11 @@ package Exp_Util is -- Find the last initialization call related to object declaration Decl function Find_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id; - -- Find the first primitive operation of a tagged type T with name Name. - -- This function allows the use of a primitive operation which is not - -- directly visible. If T is a class-wide type, then the reference is to an - -- operation of the corresponding root type. It is an error if no primitive - -- operation with the given name is found. + -- Find the first primitive operation of type T with the specified Name, + -- disregarding any visibility considerations. If T is a class-wide type, + -- then examine the primitive operations of its corresponding root type. + -- Raise Program_Error if no primitive operation with the specified Name + -- is found. function Find_Prim_Op (T : Entity_Id; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fa13bd2..391727a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3554,8 +3554,7 @@ package body Sem_Ch3 is -- Initialize the list of primitive operations to an empty list, -- to cover tagged types as well as untagged types. For untagged -- types this is used either to analyze the call as legal when - -- Core_Extensions_Allowed is True, or to issue a better error message - -- otherwise. + -- GNAT extensions are allowed, or to give better error messages. Set_Direct_Primitive_Operations (T, New_Elmt_List); @@ -5864,8 +5863,6 @@ package body Sem_Ch3 is Set_No_Tagged_Streams_Pragma (Id, No_Tagged_Streams_Pragma (T)); Set_Is_Abstract_Type (Id, Is_Abstract_Type (T)); - Set_Direct_Primitive_Operations - (Id, Direct_Primitive_Operations (T)); Set_Class_Wide_Type (Id, Class_Wide_Type (T)); if Is_Interface (T) then @@ -5895,8 +5892,6 @@ package body Sem_Ch3 is No_Tagged_Streams_Pragma (T)); Set_Is_Abstract_Type (Id, Is_Abstract_Type (T)); Set_Class_Wide_Type (Id, Class_Wide_Type (T)); - Set_Direct_Primitive_Operations (Id, - Direct_Primitive_Operations (T)); end if; -- In general the attributes of the subtype of a private type @@ -6000,16 +5995,6 @@ package body Sem_Ch3 is (Id, No_Tagged_Streams_Pragma (T)); end if; - -- For tagged types, or when prefixed-call syntax is allowed - -- for untagged types, initialize the list of primitive - -- operations to an empty list. - - if Is_Tagged_Type (Id) - or else Core_Extensions_Allowed - then - Set_Direct_Primitive_Operations (Id, New_Elmt_List); - end if; - -- Ada 2005 (AI-412): Decorate an incomplete subtype of an -- incomplete type visible through a limited with clause. @@ -6050,7 +6035,8 @@ package body Sem_Ch3 is -- When prefixed calls are enabled for untagged types, the subtype -- shares the primitive operations of its base type. Do this even - -- when Extensions_Allowed is False to issue better error messages. + -- when GNAT extensions are not allowed, in order to give better + -- error messages. Set_Direct_Primitive_Operations (Id, Direct_Primitive_Operations (Base_Type (T))); @@ -8462,8 +8448,7 @@ package body Sem_Ch3 is -- Initialize the list of primitive operations to an empty list, -- to cover tagged types as well as untagged types. For untagged -- types this is used either to analyze the call as legal when - -- Extensions_Allowed is True, or to issue a better error message - -- otherwise. + -- GNAT extensions are allowed, or to give better error messages. Set_Direct_Primitive_Operations (Derived_Type, New_Elmt_List); @@ -9862,8 +9847,7 @@ package body Sem_Ch3 is -- Initialize the list of primitive operations to an empty list, -- to cover tagged types as well as untagged types. For untagged -- types this is used either to analyze the call as legal when - -- Extensions_Allowed is True, or to issue a better error message - -- otherwise. + -- GNAT extensions are allowed, or to give better error messages. Set_Direct_Primitive_Operations (Derived_Type, New_Elmt_List); @@ -10911,6 +10895,14 @@ package body Sem_Ch3 is Make_Class_Wide_Type (Def_Id); end if; + -- When prefixed calls are enabled for untagged types, the subtype + -- shares the primitive operations of its base type. Do this even + -- when GNAT extensions are not allowed, in order to give better + -- error messages. + + Set_Direct_Primitive_Operations + (Def_Id, Direct_Primitive_Operations (T)); + Set_Stored_Constraint (Def_Id, No_Elist); if Has_Discrs then @@ -10921,17 +10913,11 @@ package body Sem_Ch3 is if Is_Tagged_Type (T) then -- Ada 2005 (AI-251): In case of concurrent types we inherit the - -- concurrent record type (which has the list of primitive - -- operations). + -- concurrent record type. - if Ada_Version >= Ada_2005 - and then Is_Concurrent_Type (T) - then - Set_Corresponding_Record_Type (Def_Id, - Corresponding_Record_Type (T)); - else - Set_Direct_Primitive_Operations (Def_Id, - Direct_Primitive_Operations (T)); + if Ada_Version >= Ada_2005 and then Is_Concurrent_Type (T) then + Set_Corresponding_Record_Type + (Def_Id, Corresponding_Record_Type (T)); end if; Set_Is_Abstract_Type (Def_Id, Is_Abstract_Type (T)); @@ -13083,6 +13069,14 @@ package body Sem_Ch3 is Set_First_Rep_Item (Full, First_Rep_Item (Full_Base)); Set_Depends_On_Private (Full, Has_Private_Component (Full)); + -- When prefixed calls are enabled for untagged types, the subtype + -- shares the primitive operations of its base type. Do this even + -- when GNAT extensions are not allowed, in order to give better + -- error messages. + + Set_Direct_Primitive_Operations + (Full, Direct_Primitive_Operations (Full_Base)); + -- Freeze the private subtype entity if its parent is delayed, and not -- already frozen. We skip this processing if the type is an anonymous -- subtype of a record component, or is the corresponding record of a @@ -13189,8 +13183,6 @@ package body Sem_Ch3 is Set_Is_Tagged_Type (Full); Set_Is_Limited_Record (Full, Is_Limited_Record (Full_Base)); - Set_Direct_Primitive_Operations - (Full, Direct_Primitive_Operations (Full_Base)); Set_No_Tagged_Streams_Pragma (Full, No_Tagged_Streams_Pragma (Full_Base)); @@ -17469,8 +17461,7 @@ package body Sem_Ch3 is -- Initialize the list of primitive operations to an empty list, -- to cover tagged types as well as untagged types. For untagged -- types this is used either to analyze the call as legal when - -- Extensions_Allowed is True, or to issue a better error message - -- otherwise. + -- GNAT extensions are allowed, or to give better error messages. Set_Direct_Primitive_Operations (T, New_Elmt_List); diff --git a/gcc/ada/sem_ch4.ads b/gcc/ada/sem_ch4.ads index 7aae598..dbe0f9a 100644 --- a/gcc/ada/sem_ch4.ads +++ b/gcc/ada/sem_ch4.ads @@ -84,9 +84,8 @@ package Sem_Ch4 is -- true then N is an N_Selected_Component node which is part of a call to -- an entry or procedure of a tagged concurrent type and this routine is -- invoked to search for class-wide subprograms conflicting with the target - -- entity. If Allow_Extensions is True, then a prefixed call of a primitive - -- of a non-tagged type is allowed as if Extensions_Allowed returned True. - -- This is used to issue better error messages. + -- entity. If Allow_Extensions is True, then a prefixed call to a primitive + -- of an untagged type is allowed (used to give better error messages). procedure Unresolved_Operator (N : Node_Id); -- Give an error for an unresolved operator |