sem_ch12.adb (Inline_Instance_Body): Remove erroneous assumption that Scope_Stack.First = 1.

2006-02-13  Thomas Quinot  <quinot@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Javier Miranda  <miranda@adacore.com>

	* sem_ch12.adb (Inline_Instance_Body): Remove erroneous assumption
	that Scope_Stack.First = 1.
	Properly handle Ada_Version_Explicit and Ada_Version_Config, which
	were not always properly handled previously.
	(Formal_Entity): Complete rewrite, to handle properly some complex case
	with multiple levels of parametrization by formal packages.
	(Analyze_Formal_Derived_Type): Propagate Ada 2005 "limited" indicator
	to the corresponding derived type declaration for proper semantics.

	* sem_prag.adb (Analyze_Pragma): Remove '!' in warning message.
	(Check_Component): Enforce restriction on components of
	unchecked_unions: a component in a variant cannot contain tasks or
	controlled types.
	(Unchecked_Union): Allow nested variants and multiple discriminants, to
	conform to AI-216.
	Add pragma Ada_2005 (synonym for Ada_05)
	Properly handle Ada_Version_Explicit and Ada_Version_Config, which
	were not always properly handled previously.
	Document that pragma Propagate_Exceptions has no effect
	(Analyze_Pragma, case Pure): Set new flag Has_Pragma_Pure
	(Set_Convention_From_Pragma): Check that if a convention is
	specified for a dispatching operation, then it must be
	consistent with the existing convention for the operation.
	(CPP_Class): Because of the C++ ABI compatibility, the programmer is no
	longer required to specify an vtable-ptr component in the record. For
	compatibility reasons we leave the support for the previous definition.
	(Analyze_Pragma, case No_Return): Allow multiple arguments

	* sem_ch3.ads, sem_ch3.adb (Check_Abstract_Overriding): Flag a
	non-overrideen inherited operation with a controlling result as
	illegal only its implicit declaration comes from the derived type
	declaration of its result's type.
	(Check_Possible_Deferred_Completion): Relocate the object definition
	node of the subtype indication of a deferred constant completion rather
	than directly analyzing it. The analysis of the generated subtype will
	correctly decorate the GNAT tree.
	(Record_Type_Declaration): Check whether this is a declaration for a
	limited derived record before analyzing components.
	(Analyze_Component_Declaration): Diagnose record types  not explicitly
	declared limited when a component has a limited type.
	(Build_Derived_Record_Type): Code reorganization to check if some of
	the inherited subprograms of a tagged type cover interface primitives.
	This check was missing in case of a full-type associated with a private
	type declaration.
	(Constant_Redeclaration): Check that the subtypes of the partial and the
	full view of a constrained deferred constant statically match.
	(Mentions_T): A reference to the current type in an anonymous access
	component declaration  must be an entity name.
	(Make_Incomplete_Type_Declaration): If type is tagged, set type of
	class_wide type to refer to full type, not to the incomplete one.
	(Add_Interface_Tag_Components): Do nothing if RE_Interface_Tag is not
	available. Required to give support to the certified run-time.
	(Analyze_Component_Declaration): In case of anonymous access components
	perform missing checks for AARM 3.9.2(9) and 3.10.2 (12.2).
	(Process_Discriminants): For an access discriminant, use the
	discriminant specification as the associated_node_for_itype, to
	simplify accessibility checks.

From-SVN: r111091

4 files changed, 670 insertions, 361 deletions

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5e8e6dc..ba3cc95 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -1351,6 +1351,7 @@ package body Sem_Ch12 is
              Subtype_Indication            => Subtype_Mark (Def));
 
          Set_Abstract_Present (New_N, Abstract_Present (Def));
+         Set_Limited_Present  (New_N, Limited_Present  (Def));
 
       else
          New_N :=
@@ -1364,6 +1365,8 @@ package body Sem_Ch12 is
 
          Set_Abstract_Present
            (Type_Definition (New_N), Abstract_Present (Def));
+         Set_Limited_Present
+           (Type_Definition (New_N), Limited_Present (Def));
       end if;
 
       Rewrite (N, New_N);
@@ -1894,7 +1897,7 @@ package body Sem_Ch12 is
             Ctrl_Type : constant Entity_Id := Find_Dispatching_Type (Nam);
 
          begin
-            if not Present (Ctrl_Type) then
+            if No (Ctrl_Type) then
                Error_Msg_N
                  ("abstract formal subprogram must have a controlling type",
                   N);
@@ -3030,9 +3033,13 @@ package body Sem_Ch12 is
                        Cunit_Entity (Current_Sem_Unit);
       Removed      : Boolean := False;
       Num_Scopes   : Int := 0;
-      Use_Clauses  : array (1 .. Scope_Stack.Last) of Node_Id;
-      Instances    : array (1 .. Scope_Stack.Last) of Entity_Id;
-      Inner_Scopes : array (1 .. Scope_Stack.Last) of Entity_Id;
+
+      Scope_Stack_Depth : constant Int :=
+                            Scope_Stack.Last - Scope_Stack.First + 1;
+
+      Use_Clauses  : array (1 .. Scope_Stack_Depth) of Node_Id;
+      Instances    : array (1 .. Scope_Stack_Depth) of Entity_Id;
+      Inner_Scopes : array (1 .. Scope_Stack_Depth) of Entity_Id;
       Num_Inner    : Int := 0;
       N_Instances  : Int := 0;
       S            : Entity_Id;
@@ -6568,16 +6575,23 @@ package body Sem_Ch12 is
       --  because each actual has the same name as the formal, and they do
       --  appear in the same order.
 
-      function Formal_Entity
-        (F       : Node_Id;
-         Act_Ent : Entity_Id) return Entity_Id;
-      --  Returns the entity associated with the given formal F. In the
-      --  case where F is a formal package, this function will iterate
-      --  through all of F's formals and enter map associations from the
+      function Get_Formal_Entity (N : Node_Id) return Entity_Id;
+      --  Retrieve entity of defining entity of  generic formal parameter.
+      --  Only the declarations of formals need to be considered when
+      --  linking them to actuals, but the declarative list may include
+      --  internal entities generated during analysis, and those are ignored.
+
+      procedure Match_Formal_Entity
+        (Formal_Node : Node_Id;
+         Formal_Ent  : Entity_Id;
+         Actual_Ent  : Entity_Id);
+      --  Associates the formal entity with the actual. In the case
+      --  where Formal_Ent is a formal package, this procedure iterates
+      --  through all of its formals and enters associations betwen the
       --  actuals occurring in the formal package's corresponding actual
-      --  package (obtained via Act_Ent) to the formal package's formal
-      --  parameters. This function is called recursively for arbitrary
-      --  levels of formal packages.
+      --  package (given by Actual_Ent) and the formal package's formal
+      --  parameters. This procedure recurses if any of the parameters is
+      --  itself a package.
 
       function Is_Instance_Of
         (Act_Spec : Entity_Id;
@@ -6641,118 +6655,109 @@ package body Sem_Ch12 is
          end case;
       end Find_Matching_Actual;
 
-      -------------------
-      -- Formal_Entity --
-      -------------------
+      -------------------------
+      -- Match_Formal_Entity --
+      -------------------------
 
-      function Formal_Entity
-        (F       : Node_Id;
-         Act_Ent : Entity_Id) return Entity_Id
+      procedure Match_Formal_Entity
+        (Formal_Node : Node_Id;
+         Formal_Ent  : Entity_Id;
+         Actual_Ent  : Entity_Id)
       is
-         Orig_Node : Node_Id := F;
          Act_Pkg   : Entity_Id;
 
       begin
-         case Nkind (Original_Node (F)) is
-            when N_Formal_Object_Declaration     =>
-               return Defining_Identifier (F);
+         Set_Instance_Of (Formal_Ent, Actual_Ent);
 
-            when N_Formal_Type_Declaration       =>
-               return Defining_Identifier (F);
+         if Ekind (Actual_Ent) = E_Package then
+            --  Record associations for each parameter
 
-            when N_Formal_Subprogram_Declaration =>
-               return Defining_Unit_Name (Specification (F));
+            Act_Pkg := Actual_Ent;
 
-            when N_Package_Declaration           =>
-               return Defining_Unit_Name (Specification (F));
+            declare
+               A_Ent  : Entity_Id := First_Entity (Act_Pkg);
+               F_Ent  : Entity_Id;
+               F_Node : Node_Id;
 
-            when N_Formal_Package_Declaration |
-                 N_Generic_Package_Declaration   =>
+               Gen_Decl : Node_Id;
+               Formals  : List_Id;
+               Actual   : Entity_Id;
 
-               if Nkind (F) = N_Generic_Package_Declaration then
-                  Orig_Node := Original_Node (F);
-               end if;
+            begin
+               --  Retrieve the actual given in the formal package declaration
 
-               Act_Pkg := Act_Ent;
+               Actual := Entity (Name (Original_Node (Formal_Node)));
 
-               --  Find matching actual package, skipping over itypes and
-               --  other entities generated when analyzing the formal. We
-               --  know that if the instantiation is legal then there is
-               --  a matching package for the formal.
+               --  The actual in the formal package declaration  may be a
+               --  renamed generic package, in which case we want to retrieve
+               --  the original generic in order to traverse its formal part.
 
-               while Ekind (Act_Pkg) /= E_Package loop
-                  Act_Pkg := Next_Entity (Act_Pkg);
-               end loop;
+               if Present (Renamed_Entity (Actual)) then
+                  Gen_Decl := Unit_Declaration_Node (Renamed_Entity (Actual));
+               else
+                  Gen_Decl := Unit_Declaration_Node (Actual);
+               end if;
 
-               declare
-                  Actual_Ent  : Entity_Id := First_Entity (Act_Pkg);
-                  Formal_Node : Node_Id;
-                  Formal_Ent  : Entity_Id;
+               Formals := Generic_Formal_Declarations (Gen_Decl);
 
-                  Gen_Decl : Node_Id;
-                  Formals  : List_Id;
+               if Present (Formals) then
+                  F_Node := First_Non_Pragma (Formals);
+               else
+                  F_Node := Empty;
+               end if;
 
-               begin
-                  --  The actual may be a renamed generic package, in which
-                  --  case we want to retrieve the original generic in order
-                  --  to traverse its formal part.
-
-                  if Present (Renamed_Entity (Entity (Name (Orig_Node)))) then
-                     Gen_Decl :=
-                       Unit_Declaration_Node (
-                         Renamed_Entity (Entity (Name (Orig_Node))));
-                  else
-                     Gen_Decl :=
-                        Unit_Declaration_Node (Entity (Name (Orig_Node)));
-                  end if;
+               while Present (A_Ent)
+                 and then Present (F_Node)
+                 and then A_Ent /= First_Private_Entity (Act_Pkg)
+               loop
+                  F_Ent := Get_Formal_Entity (F_Node);
 
-                  Formals := Generic_Formal_Declarations (Gen_Decl);
+                  if Present (F_Ent) then
 
-                  if Present (Formals) then
-                     Formal_Node := First_Non_Pragma (Formals);
-                  else
-                     Formal_Node := Empty;
+                     --  This is a formal of the original package. Record
+                     --  association and recurse.
+
+                     Find_Matching_Actual (F_Node, A_Ent);
+                     Match_Formal_Entity (F_Node, F_Ent, A_Ent);
+                     Next_Entity (A_Ent);
                   end if;
 
-                  while Present (Actual_Ent)
-                    and then Present (Formal_Node)
-                    and then Actual_Ent /= First_Private_Entity (Act_Pkg)
-                  loop
-                     --  ???  Are the following calls also needed here:
-                     --
-                     --  Set_Is_Hidden (Actual_Ent, False);
-                     --  Set_Is_Potentially_Use_Visible
-                     --    (Actual_Ent, In_Use (Act_Ent));
+                  Next_Non_Pragma (F_Node);
+               end loop;
+            end;
+         end if;
+      end Match_Formal_Entity;
 
-                     Formal_Ent := Formal_Entity (Formal_Node, Actual_Ent);
-                     if Present (Formal_Ent) then
-                        Set_Instance_Of (Formal_Ent, Actual_Ent);
-                     end if;
-                     Next_Non_Pragma (Formal_Node);
+      -----------------------
+      -- Get_Formal_Entity --
+      -----------------------
 
-                     Next_Entity (Actual_Ent);
-                  end loop;
-               end;
+      function Get_Formal_Entity (N : Node_Id) return Entity_Id is
+         Kind : constant Node_Kind := Nkind (Original_Node (N));
+      begin
+         case Kind is
+            when N_Formal_Object_Declaration     =>
+               return Defining_Identifier (N);
+
+            when N_Formal_Type_Declaration       =>
+               return Defining_Identifier (N);
 
-               return Defining_Identifier (Orig_Node);
+            when N_Formal_Subprogram_Declaration =>
+               return Defining_Unit_Name (Specification (N));
 
-            when N_Use_Package_Clause =>
-               return Empty;
+            when N_Formal_Package_Declaration    =>
+               return Defining_Identifier (Original_Node (N));
 
-            when N_Use_Type_Clause =>
-               return Empty;
+            when N_Generic_Package_Declaration   =>
+               return Defining_Identifier (Original_Node (N));
 
-            --  We return Empty for all other encountered forms of
-            --  declarations because there are some cases of nonformal
-            --  sorts of declaration that can show up (e.g., when array
-            --  formals are present). Since it's not clear what kinds
-            --  can appear among the formals, we won't raise failure here.
+            --  All other declarations are introduced by semantic analysis
+            --  and have no match in the actual.
 
-            when others =>
+            when others                          =>
                return Empty;
-
          end case;
-      end Formal_Entity;
+      end Get_Formal_Entity;
 
       --------------------
       -- Is_Instance_Of --
@@ -6987,11 +6992,12 @@ package body Sem_Ch12 is
                   end if;
 
                   if Present (Formal_Node) then
-                     Formal_Ent := Formal_Entity (Formal_Node, Actual_Ent);
+                     Formal_Ent := Get_Formal_Entity (Formal_Node);
 
                      if Present (Formal_Ent) then
                         Find_Matching_Actual (Formal_Node, Actual_Ent);
-                        Set_Instance_Of (Formal_Ent, Actual_Ent);
+                        Match_Formal_Entity
+                          (Formal_Node, Formal_Ent, Actual_Ent);
                      end if;
 
                      Next_Non_Pragma (Formal_Node);
@@ -8529,7 +8535,7 @@ package body Sem_Ch12 is
                  and then Present (Ancestor_Discr)
                loop
                   if Base_Type (Act_T) /= Base_Type (Ancestor) and then
-                    not Present (Corresponding_Discriminant (Actual_Discr))
+                    No (Corresponding_Discriminant (Actual_Discr))
                   then
                      Error_Msg_NE
                        ("discriminant & does not correspond " &
@@ -10444,7 +10450,6 @@ package body Sem_Ch12 is
           (Fname => Unit_File_Name (Get_Source_Unit (Gen_Unit)),
            Renamings_Included => True) then
          Ada_Version := Ada_Version_Type'Last;
-         Ada_Version_Explicit := Ada_Version_Explicit_Config;
       end if;
 
       Current_Instantiated_Parent := (Gen_Unit, Act_Unit, Assoc_Null);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d2442b4..7d706ce 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -658,10 +658,10 @@ package body Sem_Ch3 is
      (Def_Id : Entity_Id;
       R      : Node_Id;
       Subt   : Entity_Id);
-   --  This routine is used to set the scalar range field for a subtype
-   --  given Def_Id, the entity for the subtype, and R, the range expression
-   --  for the scalar range. Subt provides the parent subtype to be used
-   --  to analyze, resolve, and check the given range.
+   --  This routine is used to set the scalar range field for a subtype given
+   --  Def_Id, the entity for the subtype, and R, the range expression for the
+   --  scalar range. Subt provides the parent subtype to be used to analyze,
+   --  resolve, and check the given range.
 
    procedure Signed_Integer_Type_Declaration (T : Entity_Id; Def : Node_Id);
    --  Create a new signed integer entity, and apply the constraint to obtain
@@ -680,9 +680,7 @@ package body Sem_Ch3 is
      (Related_Nod : Node_Id;
       N           : Node_Id) return Entity_Id
    is
-      Anon_Type : constant Entity_Id :=
-                    Create_Itype (E_Anonymous_Access_Type, Related_Nod,
-                                  Scope_Id => Scope (Current_Scope));
+      Anon_Type  : Entity_Id;
       Desig_Type : Entity_Id;
 
    begin
@@ -692,16 +690,14 @@ package body Sem_Ch3 is
          Error_Msg_N ("task entries cannot have access parameters", N);
       end if;
 
-      --  Ada 2005: for an object declaration or function with an anonymous
-      --  access result, the corresponding anonymous type is declared in the
-      --  current scope. For access formals, access components, and access
-      --  discriminants, the scope is that of the enclosing declaration,
-      --  as set above. This special-case handling of resetting the scope
-      --  is awkward, and it might be better to pass in the required scope
-      --  as a parameter. ???
+      --  Ada 2005: for an object declaration the corresponding anonymous
+      --  type is declared in the current scope.
 
       if Nkind (Related_Nod) = N_Object_Declaration then
-         Set_Scope (Anon_Type, Current_Scope);
+         Anon_Type :=
+           Create_Itype
+            (E_Anonymous_Access_Type, Related_Nod,
+               Scope_Id => Current_Scope);
 
       --  For the anonymous function result case, retrieve the scope of
       --  the function specification's associated entity rather than using
@@ -713,7 +709,19 @@ package body Sem_Ch3 is
       elsif Nkind (Related_Nod) = N_Function_Specification
          and then Nkind (Parent (N)) /= N_Parameter_Specification
       then
-         Set_Scope (Anon_Type, Scope (Defining_Unit_Name (Related_Nod)));
+         Anon_Type :=
+           Create_Itype
+            (E_Anonymous_Access_Type, Related_Nod,
+               Scope_Id => Scope (Defining_Unit_Name (Related_Nod)));
+
+      else
+         --  For access formals, access components, and access
+         --  discriminants, the scope is that of the enclosing declaration,
+
+         Anon_Type :=
+           Create_Itype
+            (E_Anonymous_Access_Type, Related_Nod,
+               Scope_Id => Scope (Current_Scope));
       end if;
 
       if All_Present (N)
@@ -1081,9 +1089,10 @@ package body Sem_Ch3 is
       -------------
 
       procedure Add_Tag (Iface : Entity_Id) is
-         Def      : Node_Id;
-         Tag      : Entity_Id;
-         Decl     : Node_Id;
+         Decl   : Node_Id;
+         Def    : Node_Id;
+         Tag    : Entity_Id;
+         Offset : Entity_Id;
 
       begin
          pragma Assert (Is_Tagged_Type (Iface)
@@ -1115,21 +1124,52 @@ package body Sem_Ch3 is
          Set_DT_Entry_Count    (Tag,
            DT_Entry_Count (First_Entity (Iface)));
 
-         if not Present (Last_Tag) then
+         if No (Last_Tag) then
             Prepend (Decl, L);
          else
             Insert_After (Last_Tag, Decl);
          end if;
 
          Last_Tag := Decl;
+
+         --  If the ancestor has discriminants we need to give special support
+         --  to store the offset_to_top value of the secondary dispatch tables.
+         --  For this purpose we add a supplementary component just after the
+         --  field that contains the tag associated with each secondary DT.
+
+         if Typ /= Etype (Typ)
+           and then Has_Discriminants (Etype (Typ))
+         then
+            Def :=
+              Make_Component_Definition (Loc,
+                Subtype_Indication =>
+                  New_Occurrence_Of (RTE (RE_Storage_Offset), Loc));
+
+            Offset :=
+              Make_Defining_Identifier (Loc, New_Internal_Name ('V'));
+
+            Decl :=
+              Make_Component_Declaration (Loc,
+                Defining_Identifier  => Offset,
+                Component_Definition => Def);
+
+            Analyze_Component_Declaration (Decl);
+
+            Set_Analyzed (Decl);
+            Set_Ekind               (Offset, E_Component);
+            Init_Component_Location (Offset);
+            Insert_After (Last_Tag, Decl);
+            Last_Tag := Decl;
+         end if;
       end Add_Tag;
 
    --  Start of processing for Add_Interface_Tag_Components
 
    begin
       if Ekind (Typ) /= E_Record_Type
-        or else not Present (Abstract_Interfaces (Typ))
+        or else No (Abstract_Interfaces (Typ))
         or else Is_Empty_Elmt_List (Abstract_Interfaces (Typ))
+        or else not RTE_Available (RE_Interface_Tag)
       then
          return;
       end if;
@@ -1207,6 +1247,13 @@ package body Sem_Ch3 is
       --  Determines whether a constraint uses the discriminant of a record
       --  type thus becoming a per-object constraint (POC).
 
+      function Is_Known_Limited (Typ : Entity_Id) return Boolean;
+      --  Check whether enclosing record is limited, to validate declaration
+      --  of components with limited types.
+      --  This seems a wrong description to me???
+      --  What is Typ? For sure it can return a result without checking
+      --  the enclosing record (enclosing what???)
+
       ------------------
       -- Contains_POC --
       ------------------
@@ -1259,6 +1306,41 @@ package body Sem_Ch3 is
          end case;
       end Contains_POC;
 
+      ----------------------
+      -- Is_Known_Limited --
+      ----------------------
+
+      function Is_Known_Limited (Typ : Entity_Id) return Boolean is
+         P : constant Entity_Id := Etype (Typ);
+         R : constant Entity_Id := Root_Type (Typ);
+
+      begin
+         if Is_Limited_Record (Typ) then
+            return True;
+
+         --  If the root type is limited (and not a limited interface)
+         --  so is the current type
+
+         elsif Is_Limited_Record (R)
+           and then
+             (not Is_Interface (R)
+               or else not Is_Limited_Interface (R))
+         then
+            return True;
+
+         --  Else the type may have a limited interface progenitor, but a
+         --  limited record parent.
+
+         elsif R /= P
+           and then Is_Limited_Record (P)
+         then
+            return True;
+
+         else
+            return False;
+         end if;
+      end Is_Known_Limited;
+
    --  Start of processing for Analyze_Component_Declaration
 
    begin
@@ -1321,6 +1403,40 @@ package body Sem_Ch3 is
       if Present (Expression (N)) then
          Analyze_Per_Use_Expression (Expression (N), T);
          Check_Initialization (T, Expression (N));
+
+         if Ada_Version >= Ada_05
+           and then Is_Access_Type (T)
+           and then Ekind (T) = E_Anonymous_Access_Type
+         then
+            --  Check RM 3.9.2(9): "if the expected type for an expression is
+            --  an anonymous access-to-specific tagged type, then the object
+            --  designated by the expression shall not be dynamically tagged
+            --  unless it is a controlling operand in a call on a dispatching
+            --  operation"
+
+            if Is_Tagged_Type (Directly_Designated_Type (T))
+              and then
+                Ekind (Directly_Designated_Type (T)) /= E_Class_Wide_Type
+              and then
+                Ekind (Directly_Designated_Type (Etype (Expression (N)))) =
+                                                        E_Class_Wide_Type
+            then
+               Error_Msg_N
+                 ("access to specific tagged type required ('R'M 3.9.2(9))",
+                  Expression (N));
+            end if;
+
+            --  (Ada 2005: AI-230): Accessibility check for anonymous
+            --  components
+
+            if Type_Access_Level (Etype (Expression (N))) >
+               Type_Access_Level (T)
+            then
+               Error_Msg_N
+                 ("expression has deeper access level than component " &
+                  "('R'M 3.10.2 (12.2))", Expression (N));
+            end if;
+         end if;
       end if;
 
       --  The parent type may be a private view with unknown discriminants,
@@ -1406,11 +1522,19 @@ package body Sem_Ch3 is
         and then Is_Tagged_Type (Current_Scope)
       then
          if Is_Derived_Type (Current_Scope)
-           and then not Is_Limited_Record (Root_Type (Current_Scope))
+           and then not Is_Known_Limited (Current_Scope)
          then
             Error_Msg_N
               ("extension of nonlimited type cannot have limited components",
                N);
+
+            if Is_Interface (Root_Type (Current_Scope)) then
+               Error_Msg_N
+                 ("\limitedness is not inherited from limited interface", N);
+               Error_Msg_N
+                 ("\add LIMITED to type indication", N);
+            end if;
+
             Explain_Limited_Type (T, N);
             Set_Etype (Id, Any_Type);
             Set_Is_Limited_Composite (Current_Scope, False);
@@ -2067,7 +2191,7 @@ package body Sem_Ch3 is
          --  In case of errors detected in the analysis of the expression,
          --  decorate it with the expected type to avoid cascade errors
 
-         if not Present (Etype (E)) then
+         if No (Etype (E)) then
             Set_Etype (E, T);
          end if;
 
@@ -2660,7 +2784,11 @@ package body Sem_Ch3 is
       if Limited_Present (N) then
          Set_Is_Limited_Record (T);
 
-         if not Is_Limited_Type (Parent_Type) then
+         if not Is_Limited_Type (Parent_Type)
+           and then
+             (not Is_Interface (Parent_Type)
+               or else  not Is_Limited_Interface (Parent_Type))
+         then
             Error_Msg_NE ("parent type& of limited extension must be limited",
               N, Parent_Type);
          end if;
@@ -5332,7 +5460,6 @@ package body Sem_Ch3 is
       Constraint_Present     : Boolean;
       Has_Interfaces         : Boolean := False;
       Inherit_Discrims       : Boolean := False;
-      Last_Inherited_Prim_Op : Elmt_Id;
       Tagged_Partial_View    : Entity_Id;
       Save_Etype             : Entity_Id;
       Save_Discr_Constr      : Elist_Id;
@@ -5768,7 +5895,7 @@ package body Sem_Ch3 is
             Discrim := First_Discriminant (Derived_Type);
             while Present (Discrim) loop
                if not Is_Tagged
-                 and then not Present (Corresponding_Discriminant (Discrim))
+                 and then No (Corresponding_Discriminant (Discrim))
                then
                   Error_Msg_N
                     ("new discriminants must constrain old ones", Discrim);
@@ -6006,40 +6133,6 @@ package body Sem_Ch3 is
             else
                Collect_Interfaces (Type_Definition (N), Derived_Type);
             end if;
-
-            --  Ada 2005 (AI-251): The progenitor types specified in a private
-            --  extension declaration and the progenitor types specified in the
-            --  corresponding declaration of a record extension given in the
-            --  private part need not be the same; the only requirement is that
-            --  the private extension must be descended from each interface
-            --  from which the record extension is descended (AARM 7.3, 20.1/2)
-
-            if Has_Private_Declaration (Derived_Type) then
-               declare
-                  N_Partial : constant Node_Id := Parent (Tagged_Partial_View);
-                  Iface_Partial : Entity_Id;
-
-               begin
-                  if Nkind (N_Partial) = N_Private_Extension_Declaration
-                    and then not Is_Empty_List (Interface_List (N_Partial))
-                  then
-                     Iface_Partial := First (Interface_List (N_Partial));
-
-                     while Present (Iface_Partial) loop
-                        if not Interface_Present_In_Ancestor
-                                 (Derived_Type, Etype (Iface_Partial))
-                        then
-                           Error_Msg_N
-                             ("(Ada 2005) full type and private extension must"
-                              & " have the same progenitors", Derived_Type);
-                           exit;
-                        end if;
-
-                        Next (Iface_Partial);
-                     end loop;
-                  end if;
-               end;
-            end if;
          end if;
 
       else
@@ -6060,8 +6153,9 @@ package body Sem_Ch3 is
          Constrs := Discriminant_Constraint (Parent_Type);
       end if;
 
-      Assoc_List := Inherit_Components (N,
-        Parent_Base, Derived_Type, Is_Tagged, Inherit_Discrims, Constrs);
+      Assoc_List :=
+        Inherit_Components
+          (N, Parent_Base, Derived_Type, Is_Tagged, Inherit_Discrims, Constrs);
 
       --  STEP 5a: Copy the parent record declaration for untagged types
 
@@ -6208,116 +6302,103 @@ package body Sem_Ch3 is
             end;
          end if;
 
-         --  Ada 2005 (AI-251): Keep separate the management of tagged types
-         --  implementing interfaces
+         Derive_Subprograms (Parent_Type, Derived_Type);
+
+         --  Ada 2005 (AI-251): Handle tagged types implementing interfaces
 
-         if not Is_Tagged_Type (Derived_Type)
-           or else not Has_Interfaces
+         if Is_Tagged_Type (Derived_Type)
+           and then Has_Interfaces
          then
-            Derive_Subprograms (Parent_Type, Derived_Type);
+            --  Ada 2005 (AI-251): If we are analyzing a full view that has
+            --  no partial view we derive the abstract interface Subprograms
 
-         else
-            --  Ada 2005 (AI-251): Complete the decoration of tagged private
-            --  types that implement interfaces
+            if No (Tagged_Partial_View) then
+               Derive_Interface_Subprograms (Derived_Type);
 
-            if Present (Tagged_Partial_View) then
-               Derive_Subprograms
-                 (Parent_Type, Derived_Type);
+            --  Ada 2005 (AI-251): if we are analyzing a full view that has
+            --  a partial view we complete the derivation of the subprograms
 
+            else
                Complete_Subprograms_Derivation
                  (Partial_View => Tagged_Partial_View,
                   Derived_Type => Derived_Type);
+            end if;
 
-            --  Ada 2005 (AI-251): Derive the interface subprograms of all the
-            --  implemented interfaces and check if some of the subprograms
-            --  inherited from the ancestor cover some interface subprogram.
+            --  Ada 2005 (AI-251): In both cases we check if some of the
+            --  inherited subprograms cover interface primitives.
 
-            else
-               Derive_Subprograms (Parent_Type, Derived_Type);
+            declare
+               Iface_Subp      : Entity_Id;
+               Iface_Subp_Elmt : Elmt_Id;
+               Prev_Alias      : Entity_Id;
+               Subp            : Entity_Id;
+               Subp_Elmt       : Elmt_Id;
 
-               declare
-                  Subp_Elmt         : Elmt_Id;
-                  First_Iface_Elmt  : Elmt_Id;
-                  Iface_Subp_Elmt   : Elmt_Id;
-                  Subp              : Entity_Id;
-                  Iface_Subp        : Entity_Id;
-                  Is_Interface_Subp : Boolean;
+            begin
+               Iface_Subp_Elmt :=
+                 First_Elmt (Primitive_Operations (Derived_Type));
+               while Present (Iface_Subp_Elmt) loop
+                  Iface_Subp := Node (Iface_Subp_Elmt);
+
+                  --  Look for an abstract interface subprogram
+
+                  if Is_Abstract (Iface_Subp)
+                    and then Present (Alias (Iface_Subp))
+                    and then Present (DTC_Entity (Alias (Iface_Subp)))
+                    and then Is_Interface
+                               (Scope (DTC_Entity (Alias (Iface_Subp))))
+                  then
+                     --  Look for candidate primitive subprograms of the tagged
+                     --  type that can cover this interface subprogram.
 
-               begin
-                  --  Ada 2005 (AI-251): Remember the entity corresponding to
-                  --  the last inherited primitive operation. This is required
-                  --  to check if some of the inherited subprograms covers some
-                  --  of the new interfaces.
-
-                  Last_Inherited_Prim_Op := No_Elmt;
-
-                  Subp_Elmt :=
-                    First_Elmt (Primitive_Operations (Derived_Type));
-                  while Present (Subp_Elmt) loop
-                     Last_Inherited_Prim_Op := Subp_Elmt;
-                     Next_Elmt (Subp_Elmt);
-                  end loop;
+                     Subp_Elmt :=
+                       First_Elmt (Primitive_Operations (Derived_Type));
+                     while Present (Subp_Elmt) loop
+                        Subp := Node (Subp_Elmt);
 
-                  --  Ada 2005 (AI-251): Derive subprograms in abstract
-                  --  interfaces.
+                        if not Is_Abstract (Subp)
+                          and then Chars (Subp) = Chars (Iface_Subp)
+                          and then Type_Conformant (Iface_Subp, Subp)
+                        then
+                           Prev_Alias := Alias (Iface_Subp);
 
-                  Derive_Interface_Subprograms (Derived_Type);
-
-                  --  Ada 2005 (AI-251): Check if some of the inherited
-                  --  subprograms cover some of the new interfaces.
-
-                  if Present (Last_Inherited_Prim_Op) then
-                     First_Iface_Elmt := Next_Elmt (Last_Inherited_Prim_Op);
-                     Iface_Subp_Elmt  := First_Iface_Elmt;
-                     while Present (Iface_Subp_Elmt) loop
-                        Subp_Elmt := First_Elmt (Primitive_Operations
-                                                  (Derived_Type));
-                        while Subp_Elmt /= First_Iface_Elmt loop
-                           Subp       := Node (Subp_Elmt);
-                           Iface_Subp := Node (Iface_Subp_Elmt);
-
-                           Is_Interface_Subp :=
-                             Present (Alias (Subp))
-                               and then Present (DTC_Entity (Alias (Subp)))
-                               and then Is_Interface (Scope
-                                                      (DTC_Entity
-                                                       (Alias (Subp))));
-
-                           if Chars (Subp) = Chars (Iface_Subp)
-                             and then not Is_Interface_Subp
-                             and then not Is_Abstract (Subp)
-                             and then Type_Conformant (Iface_Subp, Subp)
-                           then
-                              Check_Dispatching_Operation
-                                (Subp     => Subp,
-                                 Old_Subp => Iface_Subp);
-
-                              --  Traverse the list of aliased subprograms
-
-                              declare
-                                 E : Entity_Id;
-
-                              begin
-                                 E := Alias (Subp);
-                                 while Present (Alias (E)) loop
-                                    E := Alias (E);
-                                 end loop;
-
-                                 Set_Alias (Subp, E);
-                              end;
-
-                              Set_Has_Delayed_Freeze (Subp);
-                              exit;
-                           end if;
-
-                           Next_Elmt (Subp_Elmt);
-                        end loop;
+                           Check_Dispatching_Operation
+                             (Subp     => Subp,
+                              Old_Subp => Iface_Subp);
+
+                           pragma Assert
+                             (Alias (Iface_Subp) = Subp);
+                           pragma Assert
+                             (Abstract_Interface_Alias (Iface_Subp)
+                               = Prev_Alias);
+
+                           --  Traverse the list of aliased subprograms to link
+                           --  subp with its ultimate aliased subprogram. This
+                           --  avoids problems with the backend.
+
+                           declare
+                              E : Entity_Id;
+
+                           begin
+                              E := Alias (Subp);
+                              while Present (Alias (E)) loop
+                                 E := Alias (E);
+                              end loop;
+
+                              Set_Alias (Subp, E);
+                           end;
 
-                        Next_Elmt (Iface_Subp_Elmt);
+                           Set_Has_Delayed_Freeze (Subp);
+                           exit;
+                        end if;
+
+                        Next_Elmt (Subp_Elmt);
                      end loop;
                   end if;
-               end;
-            end if;
+
+                  Next_Elmt (Iface_Subp_Elmt);
+               end loop;
+            end;
          end if;
       end if;
 
@@ -7092,10 +7173,11 @@ package body Sem_Ch3 is
    -------------------------------
 
    procedure Check_Abstract_Overriding (T : Entity_Id) is
-      Op_List  : Elist_Id;
-      Elmt     : Elmt_Id;
-      Subp     : Entity_Id;
-      Type_Def : Node_Id;
+      Op_List    : Elist_Id;
+      Elmt       : Elmt_Id;
+      Subp       : Entity_Id;
+      Alias_Subp : Entity_Id;
+      Type_Def   : Node_Id;
 
    begin
       Op_List := Primitive_Operations (T);
@@ -7105,13 +7187,22 @@ package body Sem_Ch3 is
       Elmt := First_Elmt (Op_List);
       while Present (Elmt) loop
          Subp := Node (Elmt);
+         Alias_Subp := Alias (Subp);
+
+         --  Inherited subprograms are identified by the fact that they do not
+         --  come from source, and the associated source location is the
+         --  location of the first subtype of the derived type.
 
          --  Special exception, do not complain about failure to override the
          --  stream routines _Input and _Output, as well as the primitive
          --  operations used in dispatching selects since we always provide
          --  automatic overridings for these subprograms.
 
-         if Is_Abstract (Subp)
+         if (Is_Abstract (Subp)
+               or else (Has_Controlling_Result (Subp)
+                         and then Present (Alias_Subp)
+                         and then not Comes_From_Source (Subp)
+                         and then Sloc (Subp) = Sloc (First_Subtype (T))))
            and then not Is_TSS (Subp, TSS_Stream_Input)
            and then not Is_TSS (Subp, TSS_Stream_Output)
            and then not Is_Abstract (T)
@@ -7120,31 +7211,44 @@ package body Sem_Ch3 is
            and then Chars (Subp) /= Name_uDisp_Get_Prim_Op_Kind
            and then Chars (Subp) /= Name_uDisp_Timed_Select
          then
-            if Present (Alias (Subp)) then
-
-               --  Only perform the check for a derived subprogram when
-               --  the type has an explicit record extension. This avoids
-               --  incorrectly flagging abstract subprograms for the case
-               --  of a type without an extension derived from a formal type
-               --  with a tagged actual (can occur within a private part).
+            if Present (Alias_Subp) then
+
+               --  Only perform the check for a derived subprogram when the
+               --  type has an explicit record extension. This avoids
+               --  incorrectly flagging abstract subprograms for the case of a
+               --  type without an extension derived from a formal type with a
+               --  tagged actual (can occur within a private part).
+
+               --  Ada 2005 (AI-391): In the case of an inherited function with
+               --  a controlling result of the type, the rule does not apply if
+               --  the type is a null extension (unless the parent function
+               --  itself is abstract, in which case the function must still be
+               --  be overridden). The expander will generate an overriding
+               --  wrapper function calling the parent subprogram (see
+               --  Exp_Ch3.Make_Controlling_Wrapper_Functions).
 
                Type_Def := Type_Definition (Parent (T));
                if Nkind (Type_Def) = N_Derived_Type_Definition
                  and then Present (Record_Extension_Part (Type_Def))
+                 and then
+                   (Ada_Version < Ada_05
+                      or else not Is_Null_Extension (T)
+                      or else Ekind (Subp) = E_Procedure
+                      or else not Has_Controlling_Result (Subp)
+                      or else Is_Abstract (Alias_Subp)
+                      or else Is_Access_Type (Etype (Subp)))
                then
                   Error_Msg_NE
                     ("type must be declared abstract or & overridden",
                      T, Subp);
 
                   --  Traverse the whole chain of aliased subprograms to
-                  --  complete the error notification. This is useful for
-                  --  traceability of the chain of entities when the subprogram
-                  --  corresponds with interface subprogram (that may be
-                  --  defined in another package)
+                  --  complete the error notification. This is especially
+                  --  useful for traceability of the chain of entities when the
+                  --  subprogram corresponds with an interface subprogram
+                  --  (which might be defined in another package)
 
-                  if Ada_Version >= Ada_05
-                    and then Present (Alias (Subp))
-                  then
+                  if Present (Alias_Subp) then
                      declare
                         E : Entity_Id;
 
@@ -7657,7 +7761,7 @@ package body Sem_Ch3 is
             Next_Elmt (Elmt);
          end loop;
 
-         if not Present (Elmt) then
+         if No (Elmt) then
             Append_Elmt (Node => Iface,
                          To   => Abstract_Interfaces (Derived_Type));
          end if;
@@ -8018,6 +8122,15 @@ package body Sem_Ch3 is
       Obj_Def : constant Node_Id := Object_Definition (N);
       New_T   : Entity_Id;
 
+      procedure Check_Possible_Deferred_Completion
+        (Prev_Id      : Entity_Id;
+         Prev_Obj_Def : Node_Id;
+         Curr_Obj_Def : Node_Id);
+      --  Determine whether the two object definitions describe the partial
+      --  and the full view of a constrained deferred constant. Generate
+      --  a subtype for the full view and verify that it statically matches
+      --  the subtype of the partial view.
+
       procedure Check_Recursive_Declaration (Typ : Entity_Id);
       --  If deferred constant is an access type initialized with an allocator,
       --  check whether there is an illegal recursion in the definition,
@@ -8025,6 +8138,46 @@ package body Sem_Ch3 is
       --  detected when generating init procs, but requires this additional
       --  mechanism when expansion is disabled.
 
+      ----------------------------------------
+      -- Check_Possible_Deferred_Completion --
+      ----------------------------------------
+
+      procedure Check_Possible_Deferred_Completion
+        (Prev_Id      : Entity_Id;
+         Prev_Obj_Def : Node_Id;
+         Curr_Obj_Def : Node_Id)
+      is
+      begin
+         if Nkind (Prev_Obj_Def) = N_Subtype_Indication
+           and then Present (Constraint (Prev_Obj_Def))
+           and then Nkind (Curr_Obj_Def) = N_Subtype_Indication
+           and then Present (Constraint (Curr_Obj_Def))
+         then
+            declare
+               Loc    : constant Source_Ptr := Sloc (N);
+               Def_Id : constant Entity_Id :=
+                          Make_Defining_Identifier (Loc,
+                            New_Internal_Name ('S'));
+               Decl   : constant Node_Id :=
+                          Make_Subtype_Declaration (Loc,
+                            Defining_Identifier =>
+                              Def_Id,
+                            Subtype_Indication =>
+                              Relocate_Node (Curr_Obj_Def));
+
+            begin
+               Insert_Before_And_Analyze (N, Decl);
+               Set_Etype (Id, Def_Id);
+
+               if not Subtypes_Statically_Match (Etype (Prev_Id), Def_Id) then
+                  Error_Msg_Sloc := Sloc (Prev_Id);
+                  Error_Msg_N ("subtype does not statically match deferred " &
+                               "declaration#", N);
+               end if;
+            end;
+         end if;
+      end Check_Possible_Deferred_Completion;
+
       ---------------------------------
       -- Check_Recursive_Declaration --
       ---------------------------------
@@ -8124,6 +8277,16 @@ package body Sem_Ch3 is
       --  If so, process the full constant declaration
 
       else
+         --  RM 7.4 (6): If the subtype defined by the subtype_indication in
+         --  the deferred declaration is constrained, then the subtype defined
+         --  by the subtype_indication in the full declaration shall match it
+         --  statically.
+
+         Check_Possible_Deferred_Completion
+           (Prev_Id      => Prev,
+            Prev_Obj_Def => Object_Definition (Parent (Prev)),
+            Curr_Obj_Def => Obj_Def);
+
          Set_Full_View (Prev, Id);
          Set_Is_Public (Id, Is_Public (Prev));
          Set_Is_Internal (Id);
@@ -10413,6 +10576,13 @@ package body Sem_Ch3 is
            (New_Subp, Is_Valued_Procedure (Parent_Subp));
       end if;
 
+      --  No_Return must be inherited properly. If this is overridden in the
+      --  case of a dispatching operation, then a check is made in Sem_Disp
+      --  that the overriding operation is also No_Return (no such check is
+      --  required for the case of non-dispatching operation.
+
+      Set_No_Return (New_Subp, No_Return (Parent_Subp));
+
       --  A derived function with a controlling result is abstract. If the
       --  Derived_Type is a nonabstract formal generic derived type, then
       --  inherited operations are not abstract: the required check is done at
@@ -10845,7 +11015,7 @@ package body Sem_Ch3 is
 
             Partial_View := First_Entity (Current_Scope);
             loop
-               exit when not Present (Partial_View)
+               exit when No (Partial_View)
                  or else (Has_Private_Declaration (Partial_View)
                            and then Full_View (Partial_View) = T);
 
@@ -11020,13 +11190,15 @@ package body Sem_Ch3 is
       Build_Derived_Type (N, Parent_Type, T, Is_Completion);
 
       --  AI-419:  the parent type of an explicitly limited derived type must
-      --  be limited. Interface progenitors were checked earlier.
+      --  be a limited type or a limited interface.
 
       if Limited_Present (Def) then
          Set_Is_Limited_Record (T);
 
          if not Is_Limited_Type (Parent_Type)
-           and then not Is_Interface (Parent_Type)
+           and then
+             (not Is_Interface (Parent_Type)
+               or else not Is_Limited_Interface (Parent_Type))
          then
             Error_Msg_NE ("parent type& of limited type must be limited",
               N, Parent_Type);
@@ -11273,6 +11445,21 @@ package body Sem_Ch3 is
                then
                   Error_Msg_N
                    ("completion of nonlimited type cannot be limited", N);
+
+               elsif Ekind (Prev) = E_Record_Type_With_Private
+                 and then
+                   (Nkind (N) = N_Task_Type_Declaration
+                     or else Nkind (N) = N_Protected_Type_Declaration)
+               then
+                  if not Is_Limited_Record (Prev) then
+                     Error_Msg_N
+                        ("completion of nonlimited type cannot be limited", N);
+
+                  elsif No (Interface_List (N)) then
+                     Error_Msg_N
+                        ("completion of tagged private type must be tagged",
+                           N);
+                  end if;
                end if;
 
             --  Ada 2005 (AI-251): Private extension declaration of a
@@ -12144,6 +12331,7 @@ package body Sem_Ch3 is
 
          if Ekind (Component) = E_Component
            and then Is_Tag (Component)
+           and then RTE_Available (RE_Interface_Tag)
            and then Etype  (Component) = RTE (RE_Interface_Tag)
          then
             null;
@@ -12191,6 +12379,41 @@ package body Sem_Ch3 is
       return Assoc_List;
    end Inherit_Components;
 
+   -----------------------
+   -- Is_Null_Extension --
+   -----------------------
+
+   function Is_Null_Extension (T : Entity_Id) return Boolean is
+      Full_Type_Decl : constant Node_Id := Parent (T);
+      Full_Type_Defn : constant Node_Id := Type_Definition (Full_Type_Decl);
+      Comp_List      : Node_Id;
+      First_Comp     : Node_Id;
+
+   begin
+      if not Is_Tagged_Type (T)
+        or else Nkind (Full_Type_Defn) /= N_Derived_Type_Definition
+      then
+         return False;
+      end if;
+
+      Comp_List := Component_List (Record_Extension_Part (Full_Type_Defn));
+
+      if Present (Discriminant_Specifications (Full_Type_Decl)) then
+         return False;
+
+      elsif Present (Comp_List)
+        and then Is_Non_Empty_List (Component_Items (Comp_List))
+      then
+         First_Comp := First (Component_Items (Comp_List));
+
+         return Chars (Defining_Identifier (First_Comp)) = Name_uParent
+           and then No (Next (First_Comp));
+
+      else
+         return True;
+      end if;
+   end Is_Null_Extension;
+
    ------------------------------
    -- Is_Valid_Constraint_Kind --
    ------------------------------
@@ -13111,7 +13334,7 @@ package body Sem_Ch3 is
          end if;
 
          if Nkind (Discriminant_Type (Discr)) = N_Access_Definition then
-            Discr_Type := Access_Definition (N, Discriminant_Type (Discr));
+            Discr_Type := Access_Definition (Discr, Discriminant_Type (Discr));
 
             --  Ada 2005 (AI-230): Access discriminants are now allowed for
             --  nonlimited types, and are treated like other components of
@@ -13344,6 +13567,14 @@ package body Sem_Ch3 is
          Iface_Elmt : Elmt_Id;
 
       begin
+         --  Abstract interfaces are only associated with tagged record types
+
+         if not Is_Tagged_Type (Typ)
+           or else not Is_Record_Type (Typ)
+         then
+            return;
+         end if;
+
          --  Implementations of the form:
          --    type Typ is new Iface ...
 
@@ -13361,10 +13592,11 @@ package body Sem_Ch3 is
             while Present (Iface_Elmt) loop
                Iface := Node (Iface_Elmt);
 
-               if Is_Interface (Iface)
-                 and then not Contain_Interface (Iface, Ifaces)
-               then
+               pragma Assert (Is_Interface (Iface));
+
+               if not Contain_Interface (Iface, Ifaces) then
                   Append_Elmt (Iface, Ifaces);
+                  Collect_Implemented_Interfaces (Iface, Ifaces);
                end if;
 
                Next_Elmt (Iface_Elmt);
@@ -13495,15 +13727,22 @@ package body Sem_Ch3 is
             Collect_Implemented_Interfaces (Priv_T, Priv_T_Ifaces);
             Collect_Implemented_Interfaces (Full_T, Full_T_Ifaces);
 
-            --  Ada 2005 (AI-396): The partial view shall be a descendant of
-            --  an interface type if and only if the full view is a descendant
-            --  of the interface type.
+            --  Ada 2005 (AI-251): The partial view shall be a descendant of
+            --  an interface type if and only if the full type is descendant
+            --  of the interface type (AARM 7.3 (7.3/2).
+
+            Iface := Find_Hidden_Interface (Priv_T_Ifaces, Full_T_Ifaces);
+
+            if Present (Iface) then
+               Error_Msg_NE ("interface & not implemented by full type " &
+                             "('R'M'-2005 7.3 (7.3/2))", Priv_T, Iface);
+            end if;
 
             Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces);
 
             if Present (Iface) then
                Error_Msg_NE ("interface & not implemented by partial view " &
-                             "('R'M'-2005 7.3(9))", Full_T, Iface);
+                             "('R'M'-2005 7.3 (7.3/2))", Full_T, Iface);
             end if;
          end;
       end if;
@@ -13543,7 +13782,14 @@ package body Sem_Ch3 is
          then
             null;
 
-         elsif not Is_Ancestor (Base_Type (Priv_Parent), Full_Parent) then
+         --  Ada 2005 (AI-251): If the parent of the private type declaration
+         --  is an interface there is no need to check that it is an ancestor
+         --  of the associated full type declaration. The required tests for
+         --  this case case are performed by Build_Derived_Record_Type.
+
+         elsif not Is_Interface (Base_Type (Priv_Parent))
+           and then not Is_Ancestor (Base_Type (Priv_Parent), Full_Parent)
+         then
             Error_Msg_N
               ("parent of full type must descend from parent"
                   & " of private extension", Full_Indic);
@@ -13554,7 +13800,7 @@ package body Sem_Ch3 is
          --  subtype of the full type must be constrained if and only if
          --  the ancestor subtype of the private extension is constrained.
 
-         elsif not Present (Discriminant_Specifications (Parent (Priv_T)))
+         elsif No (Discriminant_Specifications (Parent (Priv_T)))
            and then not Has_Unknown_Discriminants (Priv_T)
            and then Has_Discriminants (Base_Type (Priv_Parent))
          then
@@ -14512,8 +14758,13 @@ package body Sem_Ch3 is
 
                if Nkind (Subt) = N_Identifier then
                   return Chars (Subt) = Chars (T);
+
+               --  A reference to the current type may appear as the prefix
+               --  of a 'Class attribute.
+
                elsif Nkind (Subt) = N_Attribute_Reference
                   and then Attribute_Name (Subt) = Name_Class
+                  and then Is_Entity_Name (Prefix (Subt))
                then
                   return (Chars (Prefix (Subt))) = Chars (T);
                else
@@ -14638,8 +14889,12 @@ package body Sem_Ch3 is
 
       begin
          --  If there is a previous partial view, no need to create a new one
+         --  If the partial view is incomplete, it is given by Prev. If it is
+         --  a private declaration, full declaration is flagged accordingly.
 
-         if Prev /= T then
+         if Prev /= T
+           or else Has_Private_Declaration (T)
+         then
             return;
 
          elsif No (Inc_T) then
@@ -14671,6 +14926,7 @@ package body Sem_Ch3 is
             if Tagged_Present (Def) then
                Make_Class_Wide_Type (Inc_T);
                Set_Class_Wide_Type (T, Class_Wide_Type (Inc_T));
+               Set_Etype (Class_Wide_Type (T), T);
             end if;
          end if;
       end Make_Incomplete_Type_Declaration;
@@ -14915,6 +15171,15 @@ package body Sem_Ch3 is
 
       Final_Storage_Only := not Is_Controlled (T);
 
+      --  Ada 2005: check whether an explicit Limited is present in a derived
+      --  type declaration.
+
+      if Nkind (Parent (Def)) = N_Derived_Type_Definition
+        and then Limited_Present (Parent (Def))
+      then
+         Set_Is_Limited_Record (T);
+      end if;
+
       --  If the component list of a record type is defined by the reserved
       --  word null and there is no discriminant part, then the record type has
       --  no components and all records of the type are null records (RM 3.7)
diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index 95354d6..d4d3799 100644
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -157,6 +157,11 @@ package Sem_Ch3  is
    --  Given a discriminant somewhere in the Typ_For_Constraint tree
    --  and a Constraint, return the value of that discriminant.
 
+   function Is_Null_Extension (T : Entity_Id) return Boolean;
+   --  Returns True if the tagged type T has an N_Full_Type_Declaration that
+   --  is a null extension, meaning that it has an extension part without any
+   --  components and does not have a known discriminant part.
+
    function Is_Visible_Component (C : Entity_Id) return Boolean;
    --  Determines if a record component C is visible in the present context.
    --  Note that even though component C could appear in the entity chain
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1610c28..bec0eb5 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -341,7 +341,7 @@ package body Sem_Prag is
 
       procedure Check_Component (Comp : Node_Id);
       --  Examine Unchecked_Union component for correct use of per-object
-      --  constrained subtypes.
+      --  constrained subtypes, and for restrictions on finalizable components.
 
       procedure Check_Duplicated_Export_Name (Nam : Node_Id);
       --  Nam is an N_String_Literal node containing the external name set
@@ -988,7 +988,8 @@ package body Sem_Prag is
             declare
                Sindic : constant Node_Id :=
                           Subtype_Indication (Component_Definition (Comp));
-
+               Typ    : constant Entity_Id :=
+                          Etype (Defining_Identifier (Comp));
             begin
                if Nkind (Sindic) = N_Subtype_Indication then
 
@@ -1004,6 +1005,15 @@ package body Sem_Prag is
                        " constraint must be an Unchecked_Union", Comp);
                   end if;
                end if;
+
+               if Is_Controlled (Typ) then
+                  Error_Msg_N
+                   ("component of unchecked union cannot be controlled", Comp);
+
+               elsif Has_Task (Typ) then
+                  Error_Msg_N
+                   ("component of unchecked union cannot have tasks", Comp);
+               end if;
             end;
          end if;
       end Check_Component;
@@ -1440,12 +1450,6 @@ package body Sem_Prag is
          Comp  : Node_Id;
 
       begin
-         if Present (Variant_Part (Clist)) then
-            Error_Msg_N
-              ("Unchecked_Union may not have nested variants",
-               Variant_Part (Clist));
-         end if;
-
          if not Is_Non_Empty_List (Component_Items (Clist)) then
             Error_Msg_N
               ("Unchecked_Union may not have empty component list",
@@ -1957,6 +1961,24 @@ package body Sem_Prag is
 
          procedure Set_Convention_From_Pragma (E : Entity_Id) is
          begin
+            --  Check invalid attempt to change convention for an overridden
+            --  dispatching operation. This is Ada 2005 AI 430. Technically
+            --  this is an amendment and should only be done in Ada 2005 mode.
+            --  However, this is clearly a mistake, since the problem that is
+            --  addressed by this AI is that there is a clear gap in the RM!
+
+            if Is_Dispatching_Operation (E)
+              and then Present (Overridden_Operation (E))
+              and then C /= Convention (Overridden_Operation (E))
+            then
+               Error_Pragma_Arg
+                 ("cannot change convention for " &
+                  "overridden dispatching operation",
+                  Arg1);
+            end if;
+
+            --  Set the convention
+
             Set_Convention (E, C);
             Set_Has_Convention_Pragma (E);
 
@@ -2862,7 +2884,7 @@ package body Sem_Prag is
                else
                   Dval := Default_Value (Formal);
 
-                  if not Present (Dval) then
+                  if No (Dval) then
                      Error_Msg_NE
                        ("optional formal& does not have default value!",
                         Arg_First_Optional_Parameter, Formal);
@@ -4222,9 +4244,9 @@ package body Sem_Prag is
             Error_Msg_Sloc := Task_Dispatching_Policy_Sloc;
             Error_Pragma ("Profile (Ravenscar) incompatible with policy#");
 
-         --  Set the FIFO_Within_Priorities policy, but always
-         --  preserve System_Location since we like the error
-         --  message with the run time name.
+         --  Set the FIFO_Within_Priorities policy, but always preserve
+         --  System_Location since we like the error message with the run time
+         --  name.
 
          else
             Task_Dispatching_Policy := 'F';
@@ -4242,9 +4264,8 @@ package body Sem_Prag is
             Error_Msg_Sloc := Locking_Policy_Sloc;
             Error_Pragma ("Profile (Ravenscar) incompatible with policy#");
 
-         --  Set the Ceiling_Locking policy, but always preserve
-         --  System_Location since we like the error message with the
-         --  run time name.
+         --  Set the Ceiling_Locking policy, but preserve System_Location since
+         --  we like the error message with the run time name.
 
          else
             Locking_Policy := 'C';
@@ -4268,7 +4289,7 @@ package body Sem_Prag is
    begin
       if not Is_Pragma_Name (Chars (N)) then
          if Warn_On_Unrecognized_Pragma then
-            Error_Pragma ("unrecognized pragma%!?");
+            Error_Pragma ("unrecognized pragma%?");
          else
             return;
          end if;
@@ -4368,17 +4389,20 @@ package body Sem_Prag is
             Ada_Version_Explicit := Ada_Version;
             Check_Arg_Count (0);
 
-         ------------
-         -- Ada_05 --
-         ------------
+         ---------------------
+         -- Ada_05/Ada_2005 --
+         ---------------------
 
          --  pragma Ada_05;
          --  pragma Ada_05 (LOCAL_NAME);
 
-         --  Note: this pragma also has some specific processing in Par.Prag
+         --  pragma Ada_2005;
+         --  pragma Ada_2005 (LOCAL_NAME):
+
+         --  Note: these pragma also have some specific processing in Par.Prag
          --  because we want to set the Ada 2005 version mode during parsing.
 
-         when Pragma_Ada_05 => declare
+         when Pragma_Ada_05 | Pragma_Ada_2005 => declare
             E_Id : Node_Id;
 
          begin
@@ -4397,7 +4421,7 @@ package body Sem_Prag is
             else
                Check_Arg_Count (0);
                Ada_Version := Ada_05;
-               Ada_Version_Explicit := Ada_Version;
+               Ada_Version_Explicit := Ada_05;
             end if;
          end;
 
@@ -4618,7 +4642,7 @@ package body Sem_Prag is
 
             procedure Process_Async_Pragma is
             begin
-               if not Present (L) then
+               if No (L) then
                   Set_Is_Asynchronous (Nm);
                   return;
                end if;
@@ -5255,16 +5279,15 @@ package body Sem_Prag is
                     ("only tagged records can contain vtable pointers", Arg1);
                end if;
 
-            --  Case of tagged type with no vtable ptr
-
-            --  What is test for Typ = Root_Typ (Typ) about here ???
+            --  Case of tagged type with no user-defined vtable ptr. In this
+            --  case, because of our C++ ABI compatibility, the programmer
+            --  does not need to specify the tag component.
 
             elsif Is_Tagged_Type (Typ)
-              and then Typ = Root_Type (Typ)
               and then No (Default_DTC)
             then
-               Error_Pragma_Arg
-                 ("a cpp_class must contain a vtable pointer", Arg1);
+               Set_Is_CPP_Class (Typ);
+               Set_Is_Limited_Record (Typ);
 
             --  Tagged type that has a vtable ptr
 
@@ -5438,6 +5461,8 @@ package body Sem_Prag is
                Next_Component (DTC);
             end loop;
 
+            --  Case of tagged type with no user-defined vtable ptr
+
             if No (DTC) then
                Error_Msg_NE ("must be a& component name", Arg, Typ);
                raise Pragma_Exit;
@@ -8101,48 +8126,57 @@ package body Sem_Prag is
          -- No_Return --
          ---------------
 
-         --  pragma No_Return (procedure_LOCAL_NAME);
+         --  pragma No_Return (procedure_LOCAL_NAME {, procedure_Local_Name});
 
          when Pragma_No_Return => No_Return : declare
             Id    : Node_Id;
             E     : Entity_Id;
             Found : Boolean;
+            Arg   : Node_Id;
 
          begin
             GNAT_Pragma;
-            Check_Arg_Count (1);
-            Check_No_Identifiers;
-            Check_Arg_Is_Local_Name (Arg1);
-            Id := Expression (Arg1);
-            Analyze (Id);
+            Check_At_Least_N_Arguments (1);
 
-            if not Is_Entity_Name (Id) then
-               Error_Pragma_Arg ("entity name required", Arg1);
-            end if;
+            --  Loop through arguments of pragma
 
-            if Etype (Id) = Any_Type then
-               raise Pragma_Exit;
-            end if;
+            Arg := Arg1;
+            while Present (Arg) loop
+               Check_Arg_Is_Local_Name (Arg);
+               Id := Expression (Arg);
+               Analyze (Id);
 
-            E := Entity (Id);
+               if not Is_Entity_Name (Id) then
+                  Error_Pragma_Arg ("entity name required", Arg);
+               end if;
 
-            Found := False;
-            while Present (E)
-              and then Scope (E) = Current_Scope
-            loop
-               if Ekind (E) = E_Procedure
-                 or else Ekind (E) = E_Generic_Procedure
-               then
-                  Set_No_Return (E);
-                  Found := True;
+               if Etype (Id) = Any_Type then
+                  raise Pragma_Exit;
                end if;
 
-               E := Homonym (E);
-            end loop;
+               --  Loop to find matching procedures
 
-            if not Found then
-               Error_Pragma ("no procedures found for pragma%");
-            end if;
+               E := Entity (Id);
+               Found := False;
+               while Present (E)
+                 and then Scope (E) = Current_Scope
+               loop
+                  if Ekind (E) = E_Procedure
+                    or else Ekind (E) = E_Generic_Procedure
+                  then
+                     Set_No_Return (E);
+                     Found := True;
+                  end if;
+
+                  E := Homonym (E);
+               end loop;
+
+               if not Found then
+                  Error_Pragma_Arg ("no procedure & found for pragma%", Arg);
+               end if;
+
+               Next (Arg);
+            end loop;
          end No_Return;
 
          ------------------------
@@ -8181,7 +8215,7 @@ package body Sem_Prag is
          -- Obsolescent --
          -----------------
 
-            --  pragma Obsolescent [(static_string_EXPRESSION [, Ada_05])];
+         --  pragma Obsolescent [(static_string_EXPRESSION [, Ada_05])];
 
          when Pragma_Obsolescent => Obsolescent : declare
             Subp   : Node_Or_Entity_Id;
@@ -8789,6 +8823,8 @@ package body Sem_Prag is
 
          --  pragma Propagate_Exceptions;
 
+         --  Note: this pragma is obsolete and has no effect
+
          when Pragma_Propagate_Exceptions =>
             GNAT_Pragma;
             Check_Arg_Count (0);
@@ -8956,6 +8992,7 @@ package body Sem_Prag is
 
             Ent := Find_Lib_Unit_Name;
             Set_Is_Pure (Ent);
+            Set_Has_Pragma_Pure (Ent);
             Set_Suppress_Elaboration_Warnings (Ent);
          end Pure;
 
@@ -10146,18 +10183,14 @@ package body Sem_Prag is
 
                Discr := First_Discriminant (Typ);
 
-               if Present (Next_Discriminant (Discr)) then
-                  Error_Msg_N
-                    ("Unchecked_Union must have exactly one discriminant",
-                     Next_Discriminant (Discr));
-                  return;
-               end if;
-
-               if No (Discriminant_Default_Value (Discr)) then
-                  Error_Msg_N
-                    ("Unchecked_Union discriminant must have default value",
-                     Discr);
-               end if;
+               while Present (Discr) loop
+                  if No (Discriminant_Default_Value (Discr)) then
+                     Error_Msg_N
+                       ("Unchecked_Union discriminant must have default value",
+                        Discr);
+                  end if;
+                  Next_Discriminant (Discr);
+               end loop;
 
                Tdef  := Type_Definition (Declaration_Node (Typ));
                Clist := Component_List (Tdef);
@@ -10686,6 +10719,7 @@ package body Sem_Prag is
       Pragma_Ada_83                       => -1,
       Pragma_Ada_95                       => -1,
       Pragma_Ada_05                       => -1,
+      Pragma_Ada_2005                     => -1,
       Pragma_All_Calls_Remote             => -1,
       Pragma_Annotate                     => -1,
       Pragma_Assert                       => -1,