@@ -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
@@ -932,18 +932,17 @@ package Einfo is
-- subtypes. Contains the Digits value specified in the declaration.
-- Direct_Primitive_Operations
+-- 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. 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
@@ -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);
@@ -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;
@@ -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);
@@ -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
From: Eric Botcazou <ebotcazou@adacore.com> 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. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo-utils.adb | 4 +-- gcc/ada/einfo.ads | 34 ++++++++++++----------- gcc/ada/exp_util.adb | 8 ++---- gcc/ada/exp_util.ads | 10 +++---- gcc/ada/sem_ch3.adb | 61 ++++++++++++++++++----------------------- gcc/ada/sem_ch4.ads | 5 ++-- 6 files changed, 55 insertions(+), 67 deletions(-)