From: Eric Botcazou <ebotca...@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(-)
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index 4c86ba1c3b1..c0c79f92e13 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 dd95ea051c1..de175310ee9 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 7a756af97ea..e86e7037d1f 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 16d8e14976c..6460bf02c1b 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 fa13bd23ac7..391727a37f4 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 7aae598b32a..dbe0f9a73da 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
--
2.45.1
