2008-05-26 Javier Miranda <miranda@adacore.com>

	* einfo.ads (Abstract_Interface_Alias): Renamed as Interface_Alias.
	(Set_Abstract_Interface_Alias): Renamed as Set_Interface_Alias.
	(Is_Internal): Adding documentation on internal entities that have
 	attribute Interface_Alias (old attribute Abstract_Interface_Alias)

	* einfo.adb (Abstract_Interface_Alias): Renamed as Interface_Alias.
	(Set_Abstract_Interface_Alias): Renamed as Set_Interface_Alias.
 	Added assertion to force entities with this attribute to have
 	attribute Is_Internal set to True.
	(Next_Tag_Component): Simplify assertion using attribute Is_Tag.

	* sem_ch3.adb (Derive_Interface_Subprograms): This subprogram has been
 	renamed as Derive_Progenitor_Subprograms. In addition, its code is
 	a new implementation.
	(Add_Interface_Tag_Components): Remove special management of
	synchronized interfaces.
	(Analyze_Interface_Declaration): Minor reformating
	(Build_Derived_Record_Type): Minor reformating
	(Check_Abstract_Overriding): Avoid reporting error in case of abstract
 	predefined primitive inherited from interface type because the body of
 	internally generated predefined primitives of tagged types are generated
 	later by Freeze_Type
	(Derive_Subprogram): Avoid generating an internal name if the parent
 	subprogram overrides an interface primitive.
	(Derive_Subprograms): New implementation that keeps separate the
 	management of tagged types not implementing interfaces, from tagged
 	types that implement interfaces.
	(Is_Progenitor): New implementation.
	(Process_Full_View): Add documentation
	(Record_Type_Declaration): Replace call to Derive_Interface_Subprograms
 	by call to Derive_Progenitor_Subprograms.

	* sem_ch6.ads (Is_Interface_Conformant): New subprogram.
	(Check_Subtype_Conformant, Subtype_Conformant): Adding new argument
 	Skip_Controlling_Formals.

	* sem_ch6.adb (Is_Interface_Conformant): New subprogram.
	(Check_Conventions): New implementation. Remove local subprogram
 	Skip_Check. Remove formal Search_From of routine Check_Convention.
	(Check_Subtype_Conformant, Subtype_Conformant): Adding new argument
 	Skip_Controlling_Formals.
	(New_Overloaded_Entity): Enable addition of predefined dispatching
 	operations.

	* sem_disp.ads
	(Find_Primitive_Covering_Interface): New subprogram.

	* sem_disp.adb (Check_Dispatching_Operation): Disable registering
 	the task body procedure as a primitive of the corresponding tagged
 	type.
	(Check_Operation_From_Private_Type): Avoid adding twice an entity
 	to the list of primitives.
	(Find_Primitive_Covering_Interface): New subprogram.
	(Override_Dispatching_Operation): Add documentation.

	* sem_type.adb (Covers): Minor reformatings

	* sem_util.ads (Collect_Abstract_Interfaces): Renamed as
	Collect_Interfaces.
 	Rename formal.
	(Has_Abstract_Interfaces): Renamed as Has_Interfaces.
	(Implements_Interface): New subprogram.
	(Is_Parent): Removed.
	(Primitive_Names_Match): New subprogram.
	(Remove_Homonym): Moved here from Derive_Interface_Subprograms.
	(Ultimate_Alias): New subprogram.

	* sem_util.adb (Collect_Abstract_Interfaces): Renamed as
	Collect_Interfaces.
 	Remove special management for synchronized types. Rename formal. Remove
 	internal subprograms Interface_Present_In_Parent and Add_Interface.
	(Has_Abstract_Interfaces): Renamed as Has_Interfaces. Replace assertion
 	on non-record types by code to return false in such case.
	(Implements_Interface): New subprogram.
	(Is_Parent): Removed. No special management is now required for
 	synchronized types covering interfaces.
	(Primitive_Names_Match): New subprogram.
	(Remove_Homonym): Moved here from Derive_Interface_Subprograms.
	(Ultimate_Alias): New subprogram.

	* exp_ch3.adb (Add_Internal_Interface_Entities): New subprogram.
 	Add internal entities associated with secondary dispatch tables to
 	the list of tagged type primitives that are not interfaces.
	(Freeze_Record_Type): Add new call to Add_Internal_Interface_Entities
	(Make_Predefined_Primitive_Specs): Code reorganization to improve
 	the management of predefined equality operator. In addition, if
 	the type has an equality function corresponding with a primitive
 	defined in an interface type, the inherited equality is abstract
 	as well, and no body can be created for it.

	* exp_disp.ads (Is_Predefined_Dispatching_Operation): Moved from
 	exp_util to exp_disp.
	(Is_Predefined_Interface_Primitive): New subprogram. Returns True if
 	an entity corresponds with one of the predefined primitives required
 	to implement interfaces.
	Update copyright notice.

	* exp_disp.adb (Set_All_DT_Position): Add assertion. Exclude from the
 	final check on abstract subprograms all the primitives associated with
 	interface primitives because they must be visible in the public and
 	private part.
	(Write_DT): Use Find_Dispatching_Type to locate the name of the
	interface type. This allows the use of this routine, for debugging
	purposes, when the tagged type is not fully decorated.
	(Is_Predefined_Dispatching_Operation): Moved from exp_util to exp_disp.
 	Factorize code calling new subprogram Is_Predefined_Interface_Primitive.
	(Is_Predefined_Interface_Primitive): New subprogram. Returns True if an
 	entity corresponds with one of the predefined primitives required to
 	implement interfaces.

	* exp_util.adb (Find_Interface_ADT): New implementation
	(Find_Interface): Removed.

	* sprint.adb (Sprint_Node_Actual): Generate missing output for the
 	list of interfaces associated with nodes
	N_Formal_Derived_Type_Definition and N_Private_Extension_Declaration.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@135923 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 33 insertions, 34 deletions

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 7d3fbdf57d7..fa212a76bed 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -208,8 +208,8 @@ package body Einfo is
 
    --    Spec_PPC_List                   Node24
 
-   --    Abstract_Interface_Alias        Node25
-   --    Abstract_Interfaces             Elist25
+   --    Interface_Alias                 Node25
+   --    Interfaces                      Elist25
    --    Debug_Renaming_Link             Node25
    --    DT_Offset_To_Top_Func           Node25
    --    Task_Body_Procedure             Node25
@@ -544,18 +544,6 @@ package body Einfo is
    -- Attribute Access Functions --
    --------------------------------
 
-   function Abstract_Interfaces (Id : E) return L is
-   begin
-      pragma Assert (Is_Record_Type (Id));
-      return Elist25 (Id);
-   end Abstract_Interfaces;
-
-   function Abstract_Interface_Alias (Id : E) return E is
-   begin
-      pragma Assert (Is_Subprogram (Id));
-      return Node25 (Id);
-   end Abstract_Interface_Alias;
-
    function Accept_Address (Id : E) return L is
    begin
       return Elist21 (Id);
@@ -1538,6 +1526,18 @@ package body Einfo is
       return Flag232 (Id);
    end Implemented_By_Entry;
 
+   function Interfaces (Id : E) return L is
+   begin
+      pragma Assert (Is_Record_Type (Id));
+      return Elist25 (Id);
+   end Interfaces;
+
+   function Interface_Alias (Id : E) return E is
+   begin
+      pragma Assert (Is_Subprogram (Id));
+      return Node25 (Id);
+   end Interface_Alias;
+
    function In_Package_Body (Id : E) return B is
    begin
       return Flag48 (Id);
@@ -2941,21 +2941,6 @@ package body Einfo is
    -- Attribute Set Procedures --
    ------------------------------
 
-   procedure Set_Abstract_Interfaces (Id : E; V : L) is
-   begin
-      pragma Assert (Is_Record_Type (Id));
-      Set_Elist25 (Id, V);
-   end Set_Abstract_Interfaces;
-
-   procedure Set_Abstract_Interface_Alias (Id : E; V : E) is
-   begin
-      pragma Assert
-        (Is_Hidden (Id)
-          and then
-           (Ekind (Id) = E_Procedure or else Ekind (Id) = E_Function));
-      Set_Node25 (Id, V);
-   end Set_Abstract_Interface_Alias;
-
    procedure Set_Accept_Address (Id : E; V : L) is
    begin
       Set_Elist21 (Id, V);
@@ -3961,6 +3946,22 @@ package body Einfo is
       Set_Flag232 (Id, V);
    end Set_Implemented_By_Entry;
 
+   procedure Set_Interfaces (Id : E; V : L) is
+   begin
+      pragma Assert (Is_Record_Type (Id));
+      Set_Elist25 (Id, V);
+   end Set_Interfaces;
+
+   procedure Set_Interface_Alias (Id : E; V : E) is
+   begin
+      pragma Assert
+        (Is_Internal (Id)
+          and then Is_Hidden (Id)
+          and then (Ekind (Id) = E_Procedure
+                      or else Ekind (Id) = E_Function));
+      Set_Node25 (Id, V);
+   end Set_Interface_Alias;
+
    procedure Set_In_Package_Body (Id : E; V : B := True) is
    begin
       Set_Flag48 (Id, V);
@@ -7296,11 +7297,9 @@ package body Einfo is
 
    function Next_Tag_Component (Id : E) return E is
       Comp : Entity_Id;
-      Typ  : constant Entity_Id := Scope (Id);
 
    begin
-      pragma Assert (Ekind (Id) = E_Component
-                       and then Is_Tagged_Type (Typ));
+      pragma Assert (Is_Tag (Id));
 
       Comp := Next_Entity (Id);
       while Present (Comp) loop
@@ -8600,13 +8599,13 @@ package body Einfo is
 
          when E_Procedure                                  |
               E_Function                                   =>
-            Write_Str ("Abstract_Interface_Alias");
+            Write_Str ("Interface_Alias");
 
          when E_Record_Type                                |
               E_Record_Subtype                             |
               E_Record_Type_With_Private                   |
               E_Record_Subtype_With_Private                =>
-            Write_Str ("Abstract_Interfaces");
+            Write_Str ("Interfaces");
 
          when Task_Kind                                    =>
             Write_Str ("Task_Body_Procedure");