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.

diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index 4c86ba1c3b195b60027c29f86c57bdcd1bbc90a5..c0c79f92e136a7b478398db5d5c9bfde64b808af 100644 (file)
--- 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 dd95ea051c1b327c2a0f675bdff684b1c00cb4b4..de175310ee9d4135a126fc96d312cf3dfb0bed98 100644 (file)
--- 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 7a756af97ea3c200ba01ad15eb6714b0b7d55215..e86e7037d1ff667f06b3f72c53d0d8e82e43abcd 100644 (file)
--- 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 16d8e14976ca9ccd51e05d6e3c3806220c37cba2..6460bf02c1b563e164a95114624071809dd07455 100644 (file)
--- 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 fa13bd23ac7b25f2ffec4da905f49607f8fe7f25..391727a37f41904edaa68a73f6b2fb586d65b544 100644 (file)
--- 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 7aae598b32a1c646f21561e9172e57ed2d28a254..dbe0f9a73daf2c94418b62089515878bc548e278 100644 (file)
--- 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