2005-03-08 Javier Miranda <miranda@adacore.com>

	    Robert Dewar  <dewar@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>
	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* atree.ads, atree.adb: Add support for Elist24 field

	* atree.h: Fix wrong definition of Field27
	Add support for Elist16 field
	Add support for Elist24 field

	* einfo.ads, einfo.adb (Abstract_Interfaces,
	Set_Abstract_Interfaces): New subprograms.
	(Abstract_Interface_Alias, Set_Abstract_Interface_Alias): New
	subprograms.
	(Access_Disp_Table, Set_Access_Disp_Table): Modified to handle a list of
	entities rather than a single node.
	(Is_Interface, Set_Is_Interface): New subprogram
	(First_Tag_Component): New syntesized attribute
	(Next_Tag_Component): New synthesized attribute
	(Write_Entity_Flags): Upgraded to write Is_Interface
	(Write_Field24_Name): Upgraded to write Abstract_Interfaces
	(Write_Field25_Name): Upgraded to write Abstract_Interface_Alias
	(Task_Body_Procedure): New subprogram to read this attribute.
	(Set_Task_Body_Procedure): New subprogram to set this attribute.
	(Has_Controlled_Component): Now applies to all entities.
	This is only a documentation change, since it always worked to apply
	this to other than composite types (yielding false), but now this is
	official.
	Update documentation on Must_Be_Byte_Aligned for new spec

	* tbuild.adb, exp_dist.adb, exp_disp.adb, exp_ch3.ads, exp_ch3.adb,
	exp_attr.adb, exp_aggr.adb, exp_ch4.adb, exp_ch5.adb: Upgrade all the
	uses of the Access_Disp_Table attribute to reference the first dispatch
	table associated with a tagged type. As
	part of the implementation of abstract interface types,
	Access_Disp_Table has been redefined to contain a list of dispatch
	tables (rather than a single dispatch table).
	Similarly, upgrade all the references to Tag_Component by the
	new attribute First_Tag_Component.
	(Find_Inherited_TSS): Moved to exp_tss.
	Clean up test in Expand_N_Object_Declaration for cases
	where we need to do a separate assignment of the initial value.
	(Expand_N_Object_Declaration): If the expression in the
	declaration of a tagged type is an aggregate, no need to generate an
	additional tag assignment.
	(Freeze_Type): Now a function that returns True if the N_Freeze_Entity
	is to be deleted.
	Bit packed array ops are only called if operands are known to be
	aligned.
	(Component_Equality): When returning an N_Raise_Program_Error statement,
	ensure that its Etype is set to Empty to avoid confusing GIGI (which
	expects that only expressions have a bona fide type).
	(Make_Tag_Ctrl_Assignment): Use Build_Actual_Subtype to correctly
	determine the amount of data to be copied.

	* par.adb (P_Interface_Type_Definition): New subprogram that parses the
	new syntax rule of Ada 2005 interfaces (for AI-251 and AI-345):
	    INTERFACE_TYPE_DEFINITION ::=
	      [limited | task | protected | synchronized] interface
	        [AND interface_list]

	* par-ch3.adb (P_Type_Declaration): Modified to give support to
	interfaces.
	(P_Derived_Type_Def_Or_Private_Ext_Decl): Modified to give support to
	interfaces.
	(P_Interface_Type_Definition): New subprogram that parses the new
	syntax rule of Ada 2005 interfaces
	(P_Identifier_Declarations): fix two occurrences of 'RENAMES' in error
	messages by the correct RENAMES (quotes removed).

	* sem_prag.adb: Upgrade all the references to Tag_Component by the new
	attribute First_Tag_Component.

	* sinfo.ads, sinfo.adb: Remove OK_For_Stream flag, not used, not needed
	(Interface_List, Set_Interface_List): New subprograms.
	(Interface_Present, Set_Interface_Present): New subprograms.
	(Limited_Present, Set_Limited_Present): Available also in derived
	type definition nodes.
	(Protected_Present, Set_Protected_Present): Available also in
	record type definition and
	derived type definition nodes.
	(Synchronized_Present, Set_Synchronized_Present): New subprograms.
	(Task_Present, Set_Task_Present): New subprogram.
	(Task_Body_Procedure): Removed.
	(Set_Task_Body_Procedure): Removed.
	These subprogram have been removed because the attribute
	Task_Body_Procedure has been moved to the corresponding task type
	or task subtype entity to leave a field free to store the list
	of interfaces implemented by a task (for AI-345)
	Add Expression field to N_Raise_Statement node for Ada 2005 AI-361
	(Null_Exclusion_Present): Change to Flag11, to avoid conflict with
	expression flag Do_Range_Check
	(Exception_Junk): Change to Flag7 to accomodate above change
	(Box_Present, Default_Name, Specification, Set_Box_Present,
	Set_Default_Name, Set_Specification): Expand the expression
	"X in N_Formal_Subprogram_Declaration" into the corresponding
	two comparisons. Required to use the csinfo tool.

	* exp_ch11.adb (Expand_N_Raise_Statement): Deal with case where
	"with string" given.

        * sem_ch11.adb (Analyze_Raise_Statement): Handle case where string
        expression given.

	* par-ch11.adb (P_Raise_Statement): Recognize with string expression
	in 2005 mode

	* exp_ch9.adb (Build_Task_Proc_Specification): Modified to use entity
	attribute Task_Body_Procedure rather than the old semantic field that
	was available in the task_type_declaration node.

	* par-ch12.adb (P_Formal_Type_Definition): Modified to handle formal
	interface type definitions.
	(P_Formal_Derived_Type_Definition): Modified to handle the list of
	interfaces.

	* par-ch9.adb (P_Task): Modified to handle the list of interfaces in a
	task type declaration.
	(P_Protected): Modified to handle the list of interfaces in a
	protected type declaration.


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

1 files changed, 112 insertions, 50 deletions

diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 33f330143e5..c6117ee7b7c 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -314,8 +314,9 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Component_Association
-        or else NT (N).Nkind = N_Formal_Package_Declaration
-        or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
+        or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Package_Declaration);
       return Flag15 (N);
    end Box_Present;
 
@@ -628,7 +629,8 @@ package body Sinfo is
       (N : Node_Id) return Node_Id is
    begin
       pragma Assert (False
-        or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
+        or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration);
       return Node2 (N);
    end Default_Name;
 
@@ -1056,7 +1058,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Label
         or else NT (N).Nkind = N_Object_Declaration
         or else NT (N).Nkind = N_Subtype_Declaration);
-      return Flag11 (N);
+      return Flag7 (N);
    end Exception_Junk;
 
    function Expansion_Delayed
@@ -1110,6 +1112,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Parameter_Specification
         or else NT (N).Nkind = N_Pragma_Argument_Association
         or else NT (N).Nkind = N_Qualified_Expression
+        or else NT (N).Nkind = N_Raise_Statement
         or else NT (N).Nkind = N_Return_Statement
         or else NT (N).Nkind = N_Type_Conversion
         or else NT (N).Nkind = N_Unchecked_Expression
@@ -1403,6 +1406,28 @@ package body Sinfo is
       return Flag16 (N);
    end Implicit_With;
 
+   function Interface_List
+      (N : Node_Id) return List_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Formal_Derived_Type_Definition
+        or else NT (N).Nkind = N_Private_Extension_Declaration
+        or else NT (N).Nkind = N_Protected_Type_Declaration
+        or else NT (N).Nkind = N_Record_Definition
+        or else NT (N).Nkind = N_Task_Type_Declaration);
+      return List2 (N);
+   end Interface_List;
+
+   function Interface_Present
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Record_Definition);
+      return Flag16 (N);
+   end Interface_Present;
+
    function In_Present
       (N : Node_Id) return Boolean is
    begin
@@ -1639,6 +1664,7 @@ package body Sinfo is
       (N : Node_Id) return Boolean is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
         or else NT (N).Nkind = N_Private_Type_Declaration
         or else NT (N).Nkind = N_Record_Definition
@@ -1865,7 +1891,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Object_Declaration
         or else NT (N).Nkind = N_Parameter_Specification
         or else NT (N).Nkind = N_Subtype_Declaration);
-      return Flag9 (N);
+      return Flag11 (N);
    end Null_Exclusion_Present;
 
    function Null_Record_Present
@@ -1885,14 +1911,6 @@ package body Sinfo is
       return Node4 (N);
    end Object_Definition;
 
-   function OK_For_Stream
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Attribute_Reference);
-      return Flag4 (N);
-   end OK_For_Stream;
-
    function Original_Discriminant
       (N : Node_Id) return Node_Id is
    begin
@@ -2121,8 +2139,10 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Access_Function_Definition
-        or else NT (N).Nkind = N_Access_Procedure_Definition);
-      return Flag15 (N);
+        or else NT (N).Nkind = N_Access_Procedure_Definition
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Record_Definition);
+      return Flag6 (N);
    end Protected_Present;
 
    function Raises_Constraint_Error
@@ -2296,14 +2316,15 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Abstract_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
         or else NT (N).Nkind = N_Generic_Package_Declaration
         or else NT (N).Nkind = N_Generic_Subprogram_Declaration
         or else NT (N).Nkind = N_Package_Declaration
         or else NT (N).Nkind = N_Subprogram_Body
         or else NT (N).Nkind = N_Subprogram_Body_Stub
         or else NT (N).Nkind = N_Subprogram_Declaration
-        or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
-        or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
+        or else NT (N).Nkind = N_Subprogram_Renaming_Declaration);
       return Node1 (N);
    end Specification;
 
@@ -2388,6 +2409,15 @@ package body Sinfo is
       return List2 (N);
    end Subtype_Marks;
 
+   function Synchronized_Present
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Record_Definition);
+      return Flag7 (N);
+   end Synchronized_Present;
+
    function Tagged_Present
       (N : Node_Id) return Boolean is
    begin
@@ -2407,14 +2437,6 @@ package body Sinfo is
       return Node2 (N);
    end Target_Type;
 
-   function Task_Body_Procedure
-      (N : Node_Id) return Entity_Id is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Task_Type_Declaration);
-      return Node2 (N);
-   end Task_Body_Procedure;
-
    function Task_Definition
       (N : Node_Id) return Node_Id is
    begin
@@ -2424,6 +2446,15 @@ package body Sinfo is
       return Node3 (N);
    end Task_Definition;
 
+   function Task_Present
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Record_Definition);
+      return Flag5 (N);
+   end Task_Present;
+
    function Then_Actions
       (N : Node_Id) return List_Id is
    begin
@@ -2816,8 +2847,9 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Component_Association
-        or else NT (N).Nkind = N_Formal_Package_Declaration
-        or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
+        or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Package_Declaration);
       Set_Flag15 (N, Val);
    end Set_Box_Present;
 
@@ -3130,7 +3162,8 @@ package body Sinfo is
       (N : Node_Id; Val : Node_Id) is
    begin
       pragma Assert (False
-        or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
+        or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration);
       Set_Node2_With_Parent (N, Val);
    end Set_Default_Name;
 
@@ -3549,7 +3582,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Label
         or else NT (N).Nkind = N_Object_Declaration
         or else NT (N).Nkind = N_Subtype_Declaration);
-      Set_Flag11 (N, Val);
+      Set_Flag7 (N, Val);
    end Set_Exception_Junk;
 
    procedure Set_Expansion_Delayed
@@ -3603,6 +3636,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Parameter_Specification
         or else NT (N).Nkind = N_Pragma_Argument_Association
         or else NT (N).Nkind = N_Qualified_Expression
+        or else NT (N).Nkind = N_Raise_Statement
         or else NT (N).Nkind = N_Return_Statement
         or else NT (N).Nkind = N_Type_Conversion
         or else NT (N).Nkind = N_Unchecked_Expression
@@ -3896,6 +3930,28 @@ package body Sinfo is
       Set_Flag16 (N, Val);
    end Set_Implicit_With;
 
+   procedure Set_Interface_List
+      (N : Node_Id; Val : List_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Formal_Derived_Type_Definition
+        or else NT (N).Nkind = N_Private_Extension_Declaration
+        or else NT (N).Nkind = N_Protected_Type_Declaration
+        or else NT (N).Nkind = N_Record_Definition
+        or else NT (N).Nkind = N_Task_Type_Declaration);
+      Set_List2_With_Parent (N, Val);
+   end Set_Interface_List;
+
+   procedure Set_Interface_Present
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Record_Definition);
+      Set_Flag16 (N, Val);
+   end Set_Interface_Present;
+
    procedure Set_In_Present
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4132,6 +4188,7 @@ package body Sinfo is
       (N : Node_Id; Val : Boolean := True) is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
         or else NT (N).Nkind = N_Private_Type_Declaration
         or else NT (N).Nkind = N_Record_Definition
@@ -4358,7 +4415,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Object_Declaration
         or else NT (N).Nkind = N_Parameter_Specification
         or else NT (N).Nkind = N_Subtype_Declaration);
-      Set_Flag9 (N, Val);
+      Set_Flag11 (N, Val);
    end Set_Null_Exclusion_Present;
 
    procedure Set_Null_Record_Present
@@ -4378,14 +4435,6 @@ package body Sinfo is
       Set_Node4_With_Parent (N, Val);
    end Set_Object_Definition;
 
-   procedure Set_OK_For_Stream
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Attribute_Reference);
-      Set_Flag4 (N, Val);
-   end Set_OK_For_Stream;
-
    procedure Set_Original_Discriminant
       (N : Node_Id; Val : Node_Id) is
    begin
@@ -4614,8 +4663,10 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Access_Function_Definition
-        or else NT (N).Nkind = N_Access_Procedure_Definition);
-      Set_Flag15 (N, Val);
+        or else NT (N).Nkind = N_Access_Procedure_Definition
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Record_Definition);
+      Set_Flag6 (N, Val);
    end Set_Protected_Present;
 
    procedure Set_Raises_Constraint_Error
@@ -4789,14 +4840,15 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Abstract_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
+        or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
         or else NT (N).Nkind = N_Generic_Package_Declaration
         or else NT (N).Nkind = N_Generic_Subprogram_Declaration
         or else NT (N).Nkind = N_Package_Declaration
         or else NT (N).Nkind = N_Subprogram_Body
         or else NT (N).Nkind = N_Subprogram_Body_Stub
         or else NT (N).Nkind = N_Subprogram_Declaration
-        or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
-        or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
+        or else NT (N).Nkind = N_Subprogram_Renaming_Declaration);
       Set_Node1_With_Parent (N, Val);
    end Set_Specification;
 
@@ -4881,6 +4933,15 @@ package body Sinfo is
       Set_List2_With_Parent (N, Val);
    end Set_Subtype_Marks;
 
+   procedure Set_Synchronized_Present
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Record_Definition);
+      Set_Flag7 (N, Val);
+   end Set_Synchronized_Present;
+
    procedure Set_Tagged_Present
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4900,14 +4961,6 @@ package body Sinfo is
       Set_Node2 (N, Val); -- semantic field, no parent set
    end Set_Target_Type;
 
-   procedure Set_Task_Body_Procedure
-      (N : Node_Id; Val : Entity_Id) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Task_Type_Declaration);
-      Set_Node2 (N, Val); -- semantic field, no parent set
-   end Set_Task_Body_Procedure;
-
    procedure Set_Task_Definition
       (N : Node_Id; Val : Node_Id) is
    begin
@@ -4917,6 +4970,15 @@ package body Sinfo is
       Set_Node3_With_Parent (N, Val);
    end Set_Task_Definition;
 
+   procedure Set_Task_Present
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Record_Definition);
+      Set_Flag5 (N, Val);
+   end Set_Task_Present;
+
    procedure Set_Then_Actions
       (N : Node_Id; Val : List_Id) is
    begin