2005-06-14 Gary Dismukes <dismukes@adacore.com>

	    Javier Miranda  <miranda@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_Allocator_Expression): When an initialized
	allocator's designated type is a class-wide type, and compiling for
	Ada 2005, emit a run-time check that the accessibility level of the
	type given in the allocator's expression is not deeper than the level
	of the allocator's access type.

	(Tagged_Membership): Modified to gives support to abstract interface
	types.

	* a-tags.ads, a-tags.adb (type Type_Specific_Data): Add component
	Access_Level.
	(Descendant_Tag): New predefined function
	(Is_Descendant_At_Same_Level): New predefined function
	(Get_Access_Level): New private function
	(Set_Access_Level): New private procedure
	(IW_Membership): New function. Given the tag of an object and the tag
	associated with an interface, evaluate if the object implements the
	interface.
	(Register_Interface_Tag): New procedure used to initialize the table of
	interfaces used by the IW_Membership function.
	(Set_Offset_To_Top): Initialize the Offset_To_Top field in the prologue
	of the dispatch table.
	(Inherit_TSD): Modified to copy the table of ancestor tags plus the
	table of interfaces of the parent.
	(Expanded_Name): Raise Tag_Error if the passed tag equals No_Tag.
	(External_Tag): Raise Tag_Error if the passed tag equals No_Tag.
	(Parent_Tag): Return No_Tag in the case of a root-level tagged type,
	and raise Tag_Error if the passed tag equalis No_Tag, to conform with
	Ada 2005 semantics for the new predefined function.

	* exp_attr.adb (Expand_N_Attribute, case Attribute_Input): Generate
	call to Descendant_Tag rather than Internal_Tag.
	(Expand_N_Attribute, case Attribute_Output): Emit a check to ensure that
	the accessibility level of the attribute's Item parameter is not deeper
	than the level of the attribute's prefix type. Tag_Error is raised if
	the check fails. The check is only emitted for Ada_05.
	(Find_Stream_Subprogram): If a TSS exists on the type itself for the
	requested stream attribute, use it.
	(Expand_N_Attribute_Reference): If the designated type is an interface
	then rewrite the referenced object as a conversion to force the
	displacement of the pointer to the secondary dispatch table.
	(Expand_N_Attribute_Reference, case 'Constrained): Return false if this
	is a dereference of an object with a constrained partial view.

	* exp_ch5.adb (Expand_N_Return_Statement): When a function's result
	type is a class-wide type, emit a run-time check that the accessibility
	level of the returned object is not deeper than the level of the
	function's master (only when compiling for Ada 2005).

	* exp_disp.ads, exp_disp.adb (Ada_Actions, Action_Is_Proc,
	Action_Nb_Arg): Add entries for new Get_Access_Level and
	Set_Access_Level routines in these tables.
	(Make_DT): Generate a call to set the accessibility level of the
	tagged type in its TSD.
	(Make_DT): Code cleanup. The functionality of generating all the
	secondary dispatch tables has been moved to freeze_record_type.
	(Make_Abstract_Interface_DT): Minor code cleanup.
	(Set_All_DT_Position): Code cleanup. As part of the code cleanup
	this subprogram implements a new algorithm that provides the
	same functionality and it is more clear in case of primitives
	associated with abstract interfaces.
	(Set_All_Interfaces_DTC_Entity): Removed. As part of the code
	clean up, the functionality of this subprogram is now provided
	by Set_All_DT_Position.
	(Write_DT): New subprogram: a debugging procedure designed to be called
	within gdb to display the dispatch tables associated with a tagged
	type.
	(Collect_All_Interfaces): New subprogram that collects the whole list
	of interfaces that are directly or indirectly implemented by a tagged
	type.
	(Default_Prim_Op_Position): New subprogram that returns the fixed
	position in the dispatch table of the default primitive operations.
	(Expand_Interface_Actuals): New subprogram to generate code that
	displaces all the actuals corresponding to class-wide interfaces to
	reference the interface tag of the actual object.
	(Expand_Interface_Conversion): New subprogram. Reference the base of
	the object to give access to the interface tag associated with the
	secondary dispatch table.
	(Expand_Interface_Thunk): New subprogram that generates the code of the
	thunk. This is required for compatibility with the C+ ABI.
	(Make_Abstract_Interface_DT): New subprogram that generate the
	declarations for the secondary dispatch tables associated with an
	abstract interface.
	(Set_All_Interfaces_DTC_Entity): New subprogram that sets the DTC_Entity
	attribute for each primitive operation covering interface subprograms
	(Expand_Dispatching_Call, Fill_DT_Entry, Make_DT, Set_All_DT_Position):
	These subprograms were upgraded to give support to abstract interfaces

	* rtsfind.ads (type RE_Id): Add RE_Descendant_Tag,
	RE_Is_Descendant_At_Same_Level, RE_Get_Access_Level, and
	RE_Set_Access_Level.
	(RE_Unit_Table): Add entries for new Ada.Tags operations.
	Add support to call the followig new run-time subprograms:
	IW_Membership, Register_Interface_Tag, and Set_Offset_To_Top

	* sem_ch3.adb (Constant_Redeclaration): Allow a deferred constant to
	match its full declaration when both have an access definition with
	statically matching designated subtypes.
	(Analyze_Component_Declaration): Delete commented out code that was
	incorrectly setting the scope of an anonymous access component's type.
	(Process_Discriminants): Set Is_Local_Anonymous_Access for the type of
	an access discriminant when the containing type is nonlimited.
	(Make_Incomplete_Type_Declaration): Create an incomplete type
	declaration for a record type that includes self-referential access
	components.
	(Check_Anonymous_Access_Types): Before full analysis of a record type
	declaration, create anonymous access types for each self-referential
	access component.
	(Analyze_Component_Declaration, Array_Type_Declaration): Indicate that
	an access component in this context is a Local_Anonymous_Access, for
	proper accessibility checks.
	(Access_Definition): Set properly the scope of the anonymous access type
	created for a stand-alone access object.
	(Find_Type_Of_Object): An object declaration may be given with an access
	definition.
	(Complete_Subprograms_Derivation): New subprogram used to complete
	type derivation of private tagged types implementing interfaces.
	In this case some interface primitives may have been overriden
	with the partial-view and, instead of re-calculating them, they
	are included in the list of primitive operations of the full-view.
	(Build_Derived_Record_Type): Modified to give support to private
	types implemening interfaces.
	(Access_Definition): Reject ALL on anonymous access types.
	(Build_Derived_Record_Type): In the case of Ada 2005, allow a tagged
	type derivation to occur at a deeper accessibility level than the
	parent type.
	For the case of derivation within a generic body however, disallow the
	derivation if the derived type has an ancestor that is a formal type
	declared in the formal part of an enclosing generic.
	(Analyze_Object_Declaration): For protected objects, remove the check
	that they cannot contain interrupt handlers if not declared at library
	level.
	(Add_Interface_Tag_Components): New subprogram to add the tag components
	corresponding to all the abstract interface types implemented by a
	record type or a derived record type.
	(Analyze_Private_Extension_Declaration, Build_Derived_Record_Type,
	Derived_Type_Declaration, Find_Type_Name, Inherit_Components,
	Process_Full_View, Record_Type_Declaration): Modified to give
	support to abstract interface types
	(Collect_Interfaces): New subprogram that collects the list of
	interfaces that are not already implemented by the ancestors
	(Process_Full_View): Set flag Has_Partial_Constrained_View appropriately
	when partial view has no discriminants and full view has defaults.
	(Constrain_Access): Reject a constraint on a general access type
	if the discriminants of the designated type have defaults.
	(Access_Subprogram_Declaration): Associate the Itype node with the inner
	full-type declaration or subprogram spec. This is required to handle
	nested anonymous declarations.
	(Analyze_Private_Extension_Declaration, Build_Derived_Record_Type,
	Derived_Type_Declaration, Find_Type_Name, Inherit_Components,
	Process_Full_View, Record_Type_Declaration): Modified to give
	support to abstract interface types
	(Derive_Subprograms): Addition of a new formal to indicate if
	we are in the case of an abstact-interface derivation
	(Find_Type_Of_Subtype_Indic): Moved from the body of the package
	to the specification because it is requied to analyze all the
	identifiers found in a list of interfaces

	* debug.adb: Complete documentation of flag "-gnatdZ"

	* exp_ch3.adb: Implement config version of persistent_bss pragma
	(Check_Stream_Attributes): Use Stream_Attribute_Available instead of
	testing for TSS presence to properly enforce visibility rules.
	(Freeze_Record_Type): Code cleanup. Modified to call the subprogram
	Make_Abstract_Interfaces_DT to generate the secondary tables
	associated with abstract interfaces.
	(Build_Init_Procedure): Modified to initialize all the tags
	corresponding.
	(Component_Needs_Simple_Initialization): Similar to other tags,
	interface tags do not need initialization.
	(Freeze_Record_Type): Modified to give support to abstract interface
	types.
	(Expand_N_Object_Declaration): Do not generate an initialization for
	a scalar temporary marked as internal.

	* exp_ch6.adb (Add_Simple_Call_By_Copy_Code): Handle properly an
	in-out parameter that is a component in an initialization procedure,
	whose constraint might depend on discriminants, and that may be
	misaligned because of packing or representation clauses.
	(Is_Legal_Copy): New predicate to determine whether a possibly
	misaligned in-out actual can actually be passed by copy/return. This
	is an error in case the type is by_reference, and a warning if this is
	the consequence of a DEC import pragma on the subprogram.
	(Expand_Call, Freeze_Subprogram): Modified to give support to abstract
	interface types
	(Expand_Inlined_Call): Mark temporary generated for the return value as
	internal, so that no useless scalar normalization is generated for it.
	(Expand_N_Subprogram_Declaration): Save unanalyzed body so calls to
	null procedure can always be inlined.
	(Expand_N_Subprogram_Declaration): If this is the declaration of a null
	procedure, generate an explicit empty body for it.

	* exp_util.ads, exp_util.adb (Find_Interface_ADT): New subprogram.
	Given a type implementing an interface, returns the corresponding
	access_disp_table value.
	(Find_Interface_Tag): New subprogram. Given a type implementing an
	interface, returns the record component containing the tag of the
	interface.
	(Find_Interface_Tag): New overloaded subprogram. Subsidiary to the
	previous ones that return the corresponding tag and access_disp_table
	entities.
	(Is_Predefined_Dispatching_Operation): Determines if a subprogram
	is a predefined primitive operation.
	(Expand_Subtype_From_Expr): If the expression is a selected component
	within an initialization procedure, compute its actual subtype, because
	the component may depend on the discriminants of the enclosing record.

	* i-cpp.ads, i-cpp.adb:
	This package has been left available for compatibility with previous
	versions of the frontend. As part of the new layout this is now a
	dummy package that uses declarations available at a-tags.ads

	* par-ch3.adb (P_Identifier_Declarations): Give an error for use of
	"constant access" and "aliased [constant] access" when not compiling
	with -gnat05.
	Suppress Ada 2005 keyword warning if -gnatwY used
	(P_Identifier_Declarations): Add support for object declarations with
	access definitions.
	(Private_Extension_Declaration): Complete the documentation
	(P_Derived_Type_Def_Or_Private_Ext_Decl): Fill the inteface_list
	attribute in case of private extension declaration
	(P_Type_Declaration): Mark as "abstract" the type declarations
	corresponding with protected, synchronized and task interfaces
	(P_Declarative_Items): "not" and "overriding" are overriding indicators
	for a subprogram or instance declaration.

	* sem_ch12.adb (Analyze_Subprogram_Instantiation): Verify that an
	instantiation that is a dispatching operation has controlling access
	parameters that are null excluding.
	Save and restore Ada_Version_Explicit, for implementation of AI-362
	(Validate_Derived_Type_Instance): Add check for abstract interface
	types.
	(Analyze_Formal_Package): Establish Instantiation source for the copy of
	the generic that is created to represent the formal package.
	(Analyze_Package_Instantiation): Instantiate body immediately if the
	package is a predefined unit that contains inlined subprograms, and
	we are compiling for a Configurable_Run_Time.
	(Instantiate_Formal_Subprogram): Indicate that null default subprogram
	If the program has a null default, generate an empty body for it.

	* sem_ch6.adb, sem_ch9.adb (Analyze_Subprograms_Declaration): Update
	error message condition, null procedures are correctly detected now.
	(New_Overloaded_Entity): Bypass trivial overriding indicator check
	for subprograms in the context of protected types. Instead, the
	indicator is examined in Sem_Ch9 while analysing the subprogram
	declaration.
	(Check_Overriding_Indicator): Check consistency of overriding indicator
	on subprogram stubs as well.
	(Analyze_Subprogram_Declaration): Diagnose null procedures declared at
	the library level.
	(Analize_Subprogram_Specification): When analyzing a subprogram in which
	the type of the first formal is a concurrent type, replace this type
	by the corresponding record type.
	(Analyze_Subprogram_Body): Undo the previous work.
	(Analyze_Procedure_Call): If the call has the form Object.Op, the
	analysis of the prefix ends up analyzing the call itself, after which
	we are done.
	(Has_Interface_Formals): New subprogram subsidiary to analyze
	subprogram_specification that returns true if some non
	class-wide interface subprogram is found
	(New_Overloaded_Entity): Modified to give support to abstract
	interface types
	(Conforming_Types): In Ada 2005 mode, conformance checking of anonymous
	access to subprograms must be recursive.
	(Is_Unchecked_Conversion): Improve the test that recognizes
	instantiations of Unchecked_Conversion, and allows them in bodies that
	are to be inlined by the front-end. When the body comes from an
	instantiation, a reference to Unchecked_Conversion will be an
	Expanded_Name, even though the body has not been analyzed yet.
	Replace Is_Overriding and Not_Overriding in subprogram_indication with
	Must_Override and Must_Not_Override, to better express intent of AI.
	(Analyze_Subprogram_Body): If an overriding indicator is given, check
	that it is consistent with the overrinding status of the subprogram
	at this point.
	(Analyze_Subprogram_Declaration): Indicate that a null procedure is
	always inlined.
	If the subprogram is a null procedure, indicate that it does not need
	a completion.

	* sem_disp.adb (Check_Controlling_Type): Give support to entities
	available through limited-with clauses.
	(Check_Dispatching_Operation): A stub acts like a body, and therefore is
	allowed as the last primitive of a tagged type if it has no previous
	spec.
	(Override_Dispatching_Operation, Check_Dispatching_Operation): Modified
	to give support to abstract interface types

	* sem_res.adb (Valid_Conversion): Perform an accessibility level check
	in the case where the target type is an anonymous access type of an
	object or component (that is, when Is_Local_Anonymous_Access is true).
	Prevent the special checks for conversions of access discriminants in
	the case where the discriminant belongs to a nonlimited type, since
	such discriminants have their accessibility level defined in the same
	way as a normal component of an anonymous access type.
	(Resolve_Allocator): When an allocator's designated type is a class-wide
	type, check that the accessibility level of type given in the
	allocator's expression or subtype indication is not statically deeper
	than the level of the allocator's access type.
	(Check_Discriminant_Use): Diagnose discriminant given by an expanded
	name in a discriminant constraint of a record component.
	(Resolve_Explicit_Dereference): Do not check whether the type is
	incomplete when the dereference is a use of an access discriminant in
	an initialization procedure.
	(Resolve_Type_Conversion): Handle conversions to abstract interface
	types.
	(Valid_Tagged_Conversion): The conversion of a tagged type to an
	abstract interface type is always valid.
	(Valid_Conversion): Modified to give support to abstract interface types
	(Resolve_Actuals): Enable full error reporting on view conversions
	between unrelated by_reference array types.
	The rule for view conversions of arrays with aliased components is
	weakened in Ada 2005.
	Call to obsolescent subprogram is now considered to be a violation of
	pragma Restrictions (No_Obsolescent_Features).
	(Check_Direct_Boolean_Operator): If the boolean operation has been
	constant-folded, there is nothing to check.
	(Resolve_Comparison_Op, Resolve_Equality_Op, Resolve_Boolean_Op): Defer
	check on possible violation of restriction No_Direct_Boolean_Operators
	until after expansion of operands, to prevent spurious errors when
	operation is constant-folded.

	* sem_type.ads, sem_type.adb (Covers, Intersect_Types, Specific_Type,
	Has_Compatible_Type): Modified to give support to abstract interface
	types.
	(Interface_Present_In_Ancestor): New function to theck if some ancestor
	of a given type implements a given interface

	* sem_ch4.adb (Analyze_Call): Handle properly an indirect call whose
	prefix is a parameterless function that returns an access_to_procedure.
	(Transform_Object_Operation): Handle properly function calls of the
	form Obj.Op (X), which prior to analysis appear as indexed components.
	(Analyze_One_Call): Complete the error notification to help new Ada
	2005 users.
	(Analyze_Allocator): For an allocator without an initial value, where
	the designated type has a constrained partial view, a discriminant
	constraint is illegal.


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

1 files changed, 395 insertions, 19 deletions

diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 06060ab9ff0..71b42f7e1f6 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -30,6 +30,7 @@ with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Exp_Ch9;
 with Elists;   use Elists;
+with Freeze;   use Freeze;
 with Itypes;   use Itypes;
 with Lib.Xref; use Lib.Xref;
 with Nlists;   use Nlists;
@@ -67,6 +68,11 @@ package body Sem_Ch9 is
    --  count the entries (checking the static requirement), and compare with
    --  the given maximum.
 
+   procedure Check_Overriding_Indicator (Def : Node_Id);
+   --  Ada 2005 (AI-397): Check the overriding indicator of entries and
+   --  subprograms of protected or task types. Def is the definition of
+   --  the protected or task type.
+
    function Find_Concurrent_Spec (Body_Id : Entity_Id) return Entity_Id;
    --  Find entity in corresponding task or protected declaration. Use full
    --  view if first declaration was for an incomplete type.
@@ -1024,6 +1030,7 @@ package body Sem_Ch9 is
 
       Check_Max_Entries (N, Max_Protected_Entries);
       Process_End_Label (N, 'e', Current_Scope);
+      Check_Overriding_Indicator (N);
    end Analyze_Protected_Definition;
 
    ----------------------------
@@ -1031,9 +1038,12 @@ package body Sem_Ch9 is
    ----------------------------
 
    procedure Analyze_Protected_Type (N : Node_Id) is
-      E      : Entity_Id;
-      T      : Entity_Id;
-      Def_Id : constant Entity_Id := Defining_Identifier (N);
+      E         : Entity_Id;
+      T         : Entity_Id;
+      Def_Id    : constant Entity_Id := Defining_Identifier (N);
+      Iface     : Node_Id;
+      Iface_Def : Node_Id;
+      Iface_Typ : Entity_Id;
 
    begin
       if No_Run_Time_Mode then
@@ -1052,13 +1062,56 @@ package body Sem_Ch9 is
       end if;
 
       Set_Ekind              (T, E_Protected_Type);
+      Set_Is_First_Subtype   (T, True);
       Init_Size_Align        (T);
       Set_Etype              (T, T);
-      Set_Is_First_Subtype   (T, True);
       Set_Has_Delayed_Freeze (T, True);
       Set_Stored_Constraint  (T, No_Elist);
       New_Scope (T);
 
+      --  Ada 2005 (AI-345)
+
+      if Present (Interface_List (N)) then
+         Iface := First (Interface_List (N));
+
+         while Present (Iface) loop
+            Iface_Typ := Find_Type_Of_Subtype_Indic (Iface);
+            Iface_Def := Type_Definition (Parent (Iface_Typ));
+
+            if not Is_Interface (Iface_Typ) then
+               Error_Msg_NE ("(Ada 2005) & must be an interface",
+                             Iface, Iface_Typ);
+
+            else
+               --  Ada 2005 (AI-251): "The declaration of a specific
+               --  descendant of an interface type freezes the interface
+               --  type" RM 13.14
+
+               Freeze_Before (N, Etype (Iface));
+
+               --  Ada 2005 (AI-345): Protected types can only implement
+               --  limited, synchronized or protected interfaces.
+
+               if Limited_Present (Iface_Def)
+                 or else Synchronized_Present (Iface_Def)
+                 or else Protected_Present (Iface_Def)
+               then
+                  null;
+
+               elsif Task_Present (Iface_Def) then
+                  Error_Msg_N ("(Ada 2005) protected type cannot implement a "
+                    & "task interface", Iface);
+
+               else
+                  Error_Msg_N ("(Ada 2005) protected type cannot implement a "
+                    & "non-limited interface", Iface);
+               end if;
+            end if;
+
+            Next (Iface);
+         end loop;
+      end if;
+
       if Present (Discriminant_Specifications (N)) then
          if Has_Discriminants (T) then
 
@@ -1071,6 +1124,8 @@ package body Sem_Ch9 is
          end if;
       end if;
 
+      Set_Is_Constrained (T, not Has_Discriminants (T));
+
       Analyze (Protected_Definition (N));
 
       --  Protected types with entries are controlled (because of the
@@ -1119,9 +1174,9 @@ package body Sem_Ch9 is
    ---------------------
 
    procedure Analyze_Requeue (N : Node_Id) is
+      Count      : Natural := 0;
       Entry_Name : Node_Id := Name (N);
       Entry_Id   : Entity_Id;
-      Found      : Boolean;
       I          : Interp_Index;
       It         : Interp;
       Enclosing  : Entity_Id;
@@ -1200,29 +1255,37 @@ package body Sem_Ch9 is
 
       if Is_Overloaded (Entry_Name) then
          Get_First_Interp (Entry_Name, I, It);
-         Found := False;
          Entry_Id := Empty;
 
          while Present (It.Nam) loop
             if No (First_Formal (It.Nam))
               or else Subtype_Conformant (Enclosing, It.Nam)
             then
-               if not Found then
-                  Found := True;
+
+               --  Ada 2005 (AI-345): Since protected and task types have
+               --  primitive entry wrappers, we only consider source entries.
+
+               if Comes_From_Source (It.Nam) then
+                  Count := Count + 1;
                   Entry_Id := It.Nam;
                else
-                  Error_Msg_N ("ambiguous entry name in requeue", N);
-                  return;
+                  Remove_Interp (I);
                end if;
             end if;
 
             Get_Next_Interp (I, It);
          end loop;
 
-         if not Found then
-            Error_Msg_N ("no entry matches context",  N);
+         if Count = 0 then
+            Error_Msg_N ("no entry matches context", N);
+            return;
+
+         elsif Count > 1 then
+            Error_Msg_N ("ambiguous entry name in requeue", N);
             return;
+
          else
+            Set_Is_Overloaded (Entry_Name, False);
             Set_Entity (Entry_Name, Entry_Id);
          end if;
 
@@ -1361,7 +1424,7 @@ package body Sem_Ch9 is
 
          elsif Nkind (Alt) = N_Terminate_Alternative then
             if Terminate_Present then
-               Error_Msg_N ("Only one terminate alternative allowed", N);
+               Error_Msg_N ("only one terminate alternative allowed", N);
             else
                Terminate_Present := True;
                Check_Restriction (No_Terminate_Alternatives, N);
@@ -1462,11 +1525,16 @@ package body Sem_Ch9 is
       T_Decl :=
         Make_Protected_Type_Declaration (Loc,
          Defining_Identifier => T,
-         Protected_Definition => Relocate_Node (Protected_Definition (N)));
+         Protected_Definition => Relocate_Node (Protected_Definition (N)),
+         Interface_List       => Interface_List (N));
+
+      --  Ada 2005 (AI-399): Mark the object as aliased. Required to use
+      --  the attribute 'access
 
       O_Decl :=
         Make_Object_Declaration (Loc,
           Defining_Identifier => O_Name,
+          Aliased_Present     => Ada_Version >= Ada_05,
           Object_Definition   => Make_Identifier (Loc,  Chars (T)));
 
       Rewrite (N, T_Decl);
@@ -1489,7 +1557,6 @@ package body Sem_Ch9 is
       --  expanded twice, with disastrous result.
 
       Analyze_Protected_Type (N);
-
    end Analyze_Single_Protected;
 
    -------------------------
@@ -1518,11 +1585,16 @@ package body Sem_Ch9 is
       T_Decl :=
         Make_Task_Type_Declaration (Loc,
           Defining_Identifier => T,
-          Task_Definition     => Relocate_Node (Task_Definition (N)));
+          Task_Definition     => Relocate_Node (Task_Definition (N)),
+          Interface_List      => Interface_List (N));
+
+      --  Ada 2005 (AI-399): Mark the object as aliased. Required to use
+      --  the attribute 'access
 
       O_Decl :=
         Make_Object_Declaration (Loc,
           Defining_Identifier => O_Name,
+          Aliased_Present     => Ada_Version >= Ada_05,
           Object_Definition   => Make_Identifier (Loc, Chars (T)));
 
       Rewrite (N, T_Decl);
@@ -1690,6 +1762,7 @@ package body Sem_Ch9 is
 
       Check_Max_Entries (N, Max_Task_Entries);
       Process_End_Label (N, 'e', Current_Scope);
+      Check_Overriding_Indicator (N);
    end Analyze_Task_Definition;
 
    -----------------------
@@ -1697,8 +1770,11 @@ package body Sem_Ch9 is
    -----------------------
 
    procedure Analyze_Task_Type (N : Node_Id) is
-      T      : Entity_Id;
-      Def_Id : constant Entity_Id := Defining_Identifier (N);
+      T         : Entity_Id;
+      Def_Id    : constant Entity_Id := Defining_Identifier (N);
+      Iface     : Node_Id;
+      Iface_Def : Node_Id;
+      Iface_Typ : Entity_Id;
 
    begin
       Check_Restriction (No_Tasking, N);
@@ -1720,6 +1796,47 @@ package body Sem_Ch9 is
       Set_Stored_Constraint  (T, No_Elist);
       New_Scope (T);
 
+      --  Ada 2005 (AI-345)
+
+      if Present (Interface_List (N)) then
+         Iface := First (Interface_List (N));
+         while Present (Iface) loop
+            Iface_Typ := Find_Type_Of_Subtype_Indic (Iface);
+            Iface_Def := Type_Definition (Parent (Iface_Typ));
+
+            if not Is_Interface (Iface_Typ) then
+               Error_Msg_NE ("(Ada 2005) & must be an interface",
+                             Iface, Iface_Typ);
+
+            else
+               --  Ada 2005 (AI-251): The declaration of a specific descendant
+               --  of an interface type freezes the interface type (RM 13.14).
+
+               Freeze_Before (N, Etype (Iface));
+
+               --  Ada 2005 (AI-345): Task types can only implement limited,
+               --  synchronized or task interfaces.
+
+               if Limited_Present (Iface_Def)
+                 or else Synchronized_Present (Iface_Def)
+                 or else Task_Present (Iface_Def)
+               then
+                  null;
+
+               elsif Protected_Present (Iface_Def) then
+                  Error_Msg_N ("(Ada 2005) task type cannot implement a " &
+                    "protected interface", Iface);
+
+               else
+                  Error_Msg_N ("(Ada 2005) task type cannot implement a " &
+                    "non-limited interface", Iface);
+               end if;
+            end if;
+
+            Next (Iface);
+         end loop;
+      end if;
+
       if Present (Discriminant_Specifications (N)) then
          if Ada_Version = Ada_83 and then Comes_From_Source (N) then
             Error_Msg_N ("(Ada 83) task discriminant not allowed!", N);
@@ -1736,6 +1853,8 @@ package body Sem_Ch9 is
          end if;
       end if;
 
+      Set_Is_Constrained (T, not Has_Discriminants (T));
+
       if Present (Task_Definition (N)) then
          Analyze_Task_Definition (Task_Definition (N));
       end if;
@@ -1901,6 +2020,263 @@ package body Sem_Ch9 is
       end if;
    end Check_Max_Entries;
 
+   --------------------------------
+   -- Check_Overriding_Indicator --
+   --------------------------------
+
+   procedure Check_Overriding_Indicator (Def : Node_Id) is
+      Aliased_Hom : Entity_Id;
+      Decl        : Node_Id;
+      Def_Id      : Entity_Id;
+      Hom         : Entity_Id;
+      Ifaces      : constant List_Id := Interface_List (Parent (Def));
+      Overrides   : Boolean;
+      Spec        : Node_Id;
+      Vis_Decls   : constant List_Id := Visible_Declarations (Def);
+
+      function Matches_Prefixed_View_Profile
+        (Ifaces       : List_Id;
+         Entry_Params : List_Id;
+         Proc_Params  : List_Id) return Boolean;
+      --  Ada 2005 (AI-397): Determine if an entry parameter profile matches
+      --  the prefixed view profile of an abstract procedure. Also determine
+      --  whether the abstract procedure belongs to an implemented interface.
+
+      -----------------------------------
+      -- Matches_Prefixed_View_Profile --
+      -----------------------------------
+
+      function Matches_Prefixed_View_Profile
+        (Ifaces       : List_Id;
+         Entry_Params : List_Id;
+         Proc_Params  : List_Id) return Boolean
+      is
+         Entry_Param    : Node_Id;
+         Proc_Param     : Node_Id;
+         Proc_Param_Typ : Entity_Id;
+
+         function Includes_Interface
+           (Iface  : Entity_Id;
+            Ifaces : List_Id) return Boolean;
+         --  Determine if an interface is contained in a list of interfaces
+
+         ------------------------
+         -- Includes_Interface --
+         ------------------------
+
+         function Includes_Interface
+           (Iface  : Entity_Id;
+            Ifaces : List_Id) return Boolean
+         is
+            Ent : Entity_Id;
+
+         begin
+            Ent := First (Ifaces);
+
+            while Present (Ent) loop
+               if Etype (Ent) = Iface then
+                  return True;
+               end if;
+
+               Next (Ent);
+            end loop;
+
+            return False;
+         end Includes_Interface;
+
+      --  Start of processing for Matches_Prefixed_View_Profile
+
+      begin
+         Proc_Param := First (Proc_Params);
+         Proc_Param_Typ := Etype (Parameter_Type (Proc_Param));
+
+         --  The first parameter of the abstract procedure must be of an
+         --  interface type. The task or protected type must also implement
+         --  that interface.
+
+         if not Is_Interface (Proc_Param_Typ)
+           or else not Includes_Interface (Proc_Param_Typ, Ifaces)
+         then
+            return False;
+         end if;
+
+         Entry_Param := First (Entry_Params);
+         Proc_Param  := Next (Proc_Param);
+         while Present (Entry_Param)
+           and then Present (Proc_Param)
+         loop
+            --  The two parameters must be mode conformant and have the exact
+            --  same types.
+
+            if In_Present (Entry_Param) /= In_Present (Proc_Param)
+              or else Out_Present (Entry_Param) /= Out_Present (Proc_Param)
+              or else Etype (Parameter_Type (Entry_Param)) /=
+                      Etype (Parameter_Type (Proc_Param))
+            then
+               return False;
+            end if;
+
+            Next (Entry_Param);
+            Next (Proc_Param);
+         end loop;
+
+         --  One of the lists is longer than the other
+
+         if Present (Entry_Param) or else Present (Proc_Param) then
+            return False;
+         end if;
+
+         return True;
+      end Matches_Prefixed_View_Profile;
+
+   --  Start of processing for Check_Overriding_Indicator
+
+   begin
+      if Present (Ifaces) then
+         Decl := First (Vis_Decls);
+         while Present (Decl) loop
+
+            --  Consider entries with either "overriding" or "not overriding"
+            --  indicator present.
+
+            if Nkind (Decl) = N_Entry_Declaration
+              and then (Must_Override (Decl)
+                          or else
+                        Must_Not_Override (Decl))
+            then
+               Def_Id := Defining_Identifier (Decl);
+
+               Overrides := False;
+
+               Hom := Homonym (Def_Id);
+               while Present (Hom) loop
+
+                  --  The current entry may override a procedure from an
+                  --  implemented interface.
+
+                  if Ekind (Hom) = E_Procedure
+                    and then (Is_Abstract (Hom)
+                                or else
+                              Null_Present (Parent (Hom)))
+                  then
+                     Aliased_Hom := Hom;
+
+                     while Present (Alias (Aliased_Hom)) loop
+                        Aliased_Hom := Alias (Aliased_Hom);
+                     end loop;
+
+                     if Matches_Prefixed_View_Profile (Ifaces,
+                          Parameter_Specifications (Decl),
+                          Parameter_Specifications (Parent (Aliased_Hom)))
+                     then
+                        Overrides := True;
+                        exit;
+                     end if;
+                  end if;
+
+                  Hom := Homonym (Hom);
+               end loop;
+
+               if Overrides then
+                  if Must_Not_Override (Decl) then
+                     Error_Msg_NE ("entry& is overriding", Def_Id, Def_Id);
+                  end if;
+               else
+                  if Must_Override (Decl) then
+                     Error_Msg_NE ("entry& is not overriding", Def_Id, Def_Id);
+                  end if;
+               end if;
+
+            --  Consider subprograms with either "overriding" or "not
+            --  overriding" indicator present.
+
+            elsif Nkind (Decl) = N_Subprogram_Declaration
+              and then (Must_Override (Specification (Decl))
+                          or else
+                        Must_Not_Override (Specification (Decl)))
+            then
+               Spec := Specification (Decl);
+               Def_Id := Defining_Unit_Name (Spec);
+
+               Overrides := False;
+
+               Hom := Homonym (Def_Id);
+               while Present (Hom) loop
+
+                  --  Function
+
+                  if Ekind (Def_Id) = E_Function
+                    and then Ekind (Hom) = E_Function
+                    and then Is_Abstract (Hom)
+                    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)))
+                  then
+                     Overrides := True;
+                     exit;
+
+                  --  Procedure
+
+                  elsif Ekind (Def_Id) = E_Procedure
+                    and then Ekind (Hom) = E_Procedure
+                    and then (Is_Abstract (Hom)
+                                or else
+                              Null_Present (Parent (Hom)))
+                    and then Matches_Prefixed_View_Profile (Ifaces,
+                               Parameter_Specifications (Spec),
+                               Parameter_Specifications (Parent (Hom)))
+                  then
+                     Overrides := True;
+                     exit;
+                  end if;
+
+                  Hom := Homonym (Hom);
+               end loop;
+
+               if Overrides then
+                  if Must_Not_Override (Spec) then
+                     Error_Msg_NE
+                       ("subprogram& is overriding", Def_Id, Def_Id);
+                  end if;
+               else
+                  if Must_Override (Spec) then
+                     Error_Msg_NE
+                       ("subprogram& is not overriding", Def_Id, Def_Id);
+                  end if;
+               end if;
+            end if;
+
+            Next (Decl);
+         end loop;
+
+      --  The protected or task type is not implementing an interface,
+      --  we need to check for the presence of "overriding" entries or
+      --  subprograms and flag them as erroneous.
+
+      else
+         Decl := First (Vis_Decls);
+
+         while Present (Decl) loop
+            if Nkind (Decl) = N_Entry_Declaration
+              and then Must_Override (Decl)
+            then
+               Def_Id := Defining_Identifier (Decl);
+               Error_Msg_NE ("entry& is not overriding", Def_Id, Def_Id);
+
+            elsif Nkind (Decl) = N_Subprogram_Declaration
+              and then Must_Override (Specification (Decl))
+            then
+               Def_Id := Defining_Identifier (Specification (Decl));
+               Error_Msg_NE ("subprogram& is not overriding", Def_Id, Def_Id);
+            end if;
+
+            Next (Decl);
+         end loop;
+      end if;
+   end Check_Overriding_Indicator;
+
    --------------------------
    -- Find_Concurrent_Spec --
    --------------------------