a-tags.adb (IW_Membership): Give support to "Iface_CW_Typ in T'Class".

2005-09-01  Hristian Kirtchev  <kirtchev@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* a-tags.adb (IW_Membership): Give support to
	"Iface_CW_Typ in T'Class". For this purpose the functionality of this
	subprogram has been extended to look for the tag in the ancestors tag
	table.
	Update the structure of the GNAT Dispatch Table to reflect the
	additional two tables used in dispatching selects.
	Introduce appropriate array types and record components in
	Type_Specific_Data to reflect the two tables.
	(Get_Entry_Index, Set_Entry_Index): Retrieve and set the entry index in
	the TSD of a tag, indexed by position.
	(Get_Prim_Op_Kind, Set_Prim_Op_Kind): Retrieve and set the primitive
	operation kind in the TSD of a tag, indexed by position.

	* a-tags.ads: Introduce an enumeration type to capture different
	primitive operation kinds. Define a constant reflecting the number of
	predefined primitive operations.
	(Get_Entry_Index, Set_Entry_Index): Set and retrieve the entry index
	of an entry wrapper.
	(Get_Prim_Op_Kind, Set_Prim_Op_Kind): Set and retrieve the kind of
	callable entity of a primitive operation.

	* exp_ch3.adb (Freeze_Record_Type): Generate the declarations of the
	primitive operations used in dispatching selects for limited
	interfaces, limited tagged, task and protected types what implement a
	limited interface.
	(Freeze_Type): Generate the bodies of the primitive operations used in
	dispatching selects for limited tagged, task and protected types that
	implement a limited interface. Generate statements to populate the two
	auxiliary tables used for dispatching in select statements.
	(Freeze_Record_Type): Add call to initialize the dispatch table entries
	associated with predefined interface primitive operations.
	(Build_Dcheck_Function): Change Set_Subtype_Mark to
	Set_Result_Definition.
	(Build_Variant_Record_Equality): Change Subtype_Mark to
	Result_Definition.
	(Freeze_Enumeration_Type): Change Subtype_Mark to Result_Definition.
	(Predef_Spec_Or_Body): Change Subtype_Mark to Result_Definition.
	(Build_Assignment): Simplify the code that adds the run-time-check.
	(Expand_N_Object_Declaration): Code cleanup.

	* exp_ch7.adb (Make_Clean): Select the appropriate type for locking
	entries when there is a protected type that implements a limited
	interface.

	* exp_ch9.adb: Add package Select_Expansion_Utilities that contains
	common routines used in expansion of dispatching selects.
	(Add_Private_Declarations): Select the appropriate protection type when
	there is a protected type that implements a limited interface.
	(Build_Parameter_Block): Generate a wrapped parameter block.
	(Build_Protected_Subprogram_Body): Select the appropriate type for
	locking entries when there is a protected type that implements a
	limited interface.
	(Build_Wrapper_Spec): Set the flag and wrapped entity for procedures
	classified as entry wrappers.
	(Expand_N_Asynchronous_Select): Add support for expansion of dispatching
	asynchronous selects.
	(Expand_N_Conditional_Entry_Call): Add support for expansion of
	dispatching conditional selects.
	(Expand_N_Protected_Type_Declaration): Select the appropriate type for
	protection when there is a protected type that implements limited
	interfaces.
	(Expand_N_Timed_Entry_Call): Add support for expansion of dispatching
	timed selects.
	(Extract_Dispatching_Call): Extract the entity of the name of a
	dispatching call, the object parameter, actual parameters and
	corresponding formals.
	(Make_Initialize_Protection): Correct logic of protection initialization
	when there is a protected type that implements a limited interface.
	(Parameter_Block_Pack): Populate a wrapped parameter block with the
	values of actual parameters.
	(Parameter_Block_Unpack): Retrieve the values from a wrapped parameter
	block and assign them to the original actual parameters.

	* exp_ch9.ads (Subprogram_Protection_Mode): New type.
	(Build_Protected_Sub_Specification): Change the type and name of the
	last formal to account for the increased variety of protection modes.

	* einfo.ads, einfo.adb (Was_Hidden): New attribute. Present in all
	entities. Used to save the value of the Is_Hidden attribute when the
	limited-view is installed.
	(Is_Primitive_Wrapper, Set_Is_Primitive_Wrapper): Retrieve and change
	the attribute of procedures classified as entry wrappers.
	(Wrapped_Entity, Set_Wrapped_Entity): Retrieve and change the wrapped
	entity of a primitive wrapper.
	(Write_Entity_Flags): Output the name and value of the
	Is_Primitive_Wrapper attribute.
	(Write_Field27_Name): Output the name and entity of the field Wrapped_
	Entity.
	(Underlying_Type): If we have an incomplete entity that comes from
	the limited view then we return the Underlying_Type of its non-limited
	view if it is already available.
	(Abstract_Interface_Alias): Flag applies to all subrogram kinds,
	including operators.
	(Write_Field26_Name): Add entry for Overridden_Operation
	(Overridden_Operation): New attribute of functions and procedures.

	* exp_disp.ads, exp_disp.adb (Default_Prim_Op_Position): Return a
	predefined position in the dispatch table for the primitive operations
	used in dispatching selects.
	(Init_Predefined_Interface_Primitives): Remove the hardcoded number of
	predefined primitive operations and replace it with
	Default_Prim_Op_Count.
	(Make_Disp_Asynchronous_Select_Spec, Make_Disp_Conditional_Select_Spec,
	Make_Disp_Get_Prim_Op_Kind_Spec, Make_Disp_Timed_Select_Spec): Update
	the names of the generated primitive operations used in dispatching
	selects.
	(Init_Predefined_Interface_Primitives): No need to inherit primitives in
	case of abstract interface types. They will be inherit by the objects
	implementing the interface.
	(Make_DT): There is no need to inherit the dispatch table of the
	ancestor interface for the elaboration of abstract interface types.
	The dispatch table will be inherited by the object implementing the
	interface.
	(Copy_Secondary_DTs): Add documentation.
	(Validate_Position): Improve this static check in case of
	aliased subprograms because aliased subprograms must have
	the same position.
	(Init_Predefined_Interface_Primitives): New subprogram that initializes
	the entries associated with predefined primitives of all the secondary
	dispatch tables.
	(Build_Anonymous_Access_Type): Removed.
	(Expand_Interface_Actuals): With the previous cleanup there is no need
	to build an anonymous access type. This allows further cleanup in the
	code generated by the expander.
	(Expand_Interface_Conversion): If the actual is an access type then
	build an internal function to handle the displacement. If the actual
	is null this function returns null because no displacement is
	required; otherwise performs a type conversion that will be
	expanded in the code that returns the value of the displaced actual.
	(Expand_Interface_Actuals): Avoid the generation of unnecessary type
	conversions that have no effect in the generated code because no
	displacement is required. Code cleanup; use local variables to
	avoid repeated calls to the subprogram directly_designated_type().

	* exp_util.ads, exp_util.adb (Is_Predefined_Dispatching_Operation):
	Classify the primitive operations used in dispatching selects as
	predefined.
	(Implements_Limited_Interface): Determine whether some type either
	directly implements a limited interface or extends a type that
	implements a limited interface.
	(Build_Task_Image_Function): Change Subtype_Mark to Result_Definition.
	(Expand_Subtype_From_Expr): Do not build actual subtype if the
	expression is limited.
	(Find_Interface_Tag): Add code to handle class-wide types and
	entities from the limited-view.

	* rtsfind.ads: Add entries in RE_Id and RE_Unit_Table for
	Get_Entry_Index, Get_Prim_Op_Kind, POK_Function, POK_Procedure,
	POK_Protected_Entry, POK_Protected_Function, POK_Protected_Procedure,
	POK_Task_Entry, POK_Task_Procedure, Prim_Op_Kind, Set_Entry_Index,
	Set_Prim_Op_Kind.

	* sem_ch9.adb (Analyze_Triggering_Alternative): Check for legal type
	of procedure name or prefix that appears as a trigger in a triggering
	alternative.

	* uintp.ads: Introduce constants Uint_11 and Uint_13.

From-SVN: r103850

1 files changed, 21 insertions, 4 deletions

diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index d7e9ccc..190706c 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -1924,8 +1924,25 @@ package body Sem_Ch9 is
         and then Nkind (Trigger) /= N_Delay_Relative_Statement
         and then Nkind (Trigger) /= N_Entry_Call_Statement
       then
-         Error_Msg_N
-          ("triggering statement must be delay or entry call", Trigger);
+         if Ada_Version < Ada_05 then
+            Error_Msg_N
+             ("triggering statement must be delay or entry call", Trigger);
+
+         --  Ada 2005 (AI-345): If a procedure_call_statement is used
+         --  for a procedure_or_entry_call, the procedure_name or pro-
+         --  cedure_prefix of the procedure_call_statement shall denote
+         --  an entry renamed by a procedure, or (a view of) a primitive
+         --  subprogram of a limited interface whose first parameter is
+         --  a controlling parameter.
+
+         elsif Nkind (Trigger) = N_Procedure_Call_Statement
+           and then not Is_Renamed_Entry (Entity (Name (Trigger)))
+           and then not Is_Controlling_Limited_Procedure
+                          (Entity (Name (Trigger)))
+         then
+            Error_Msg_N ("triggering statement must be delay, procedure " &
+                         "or entry call", Trigger);
+         end if;
       end if;
 
       if Is_Non_Empty_List (Statements (N)) then
@@ -2211,8 +2228,8 @@ package body Sem_Ch9 is
                     and then Matches_Prefixed_View_Profile (Ifaces,
                                Parameter_Specifications (Spec),
                                Parameter_Specifications (Parent (Hom)))
-                    and then Etype (Subtype_Mark (Spec)) =
-                             Etype (Subtype_Mark (Parent (Hom)))
+                    and then Etype (Result_Definition (Spec)) =
+                             Etype (Result_Definition (Parent (Hom)))
                   then
                      Overrides := True;
                      exit;