einfo.ads, einfo.adb: Create a limited view of an incomplete type...

2007-08-14  Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* einfo.ads, einfo.adb: Create a limited view of an incomplete type,
	to make treatment of limited views uniform for all visible declarations
	in a limited_withed package.
	Improve warnings for in out parameters
	(Set_Related_Interaface/Related_Interface): Allow the use of this
	attribute with constants.
	(Write_Field26_Name): Handle attribute Related_Interface in constants.
	Warn on duplicate pragma Preelaborable_Initialialization

	* sem_ch6.ads, sem_ch6.adb (Analyze_Subprogram_Body): Force the
	generation of a freezing node to ensure proper management of null
	excluding access types in the backend.
	(Create_Extra_Formals): Test base type of the formal when checking for
	the need to add an extra accessibility-level formal. Pass the entity E
	on all calls to Add_Extra_Formal (rather than Scope (Formal) as was
	originally being done in a couple of cases), to ensure that the
	Extra_Formals list gets set on the entity E when the first entity is
	added.
	(Conforming_Types): Add missing calls to Base_Type to the code that
	handles anonymous access types. This is required to handle the
	general case because Process_Formals builds internal subtype entities
	to handle null-excluding access types.
	(Make_Controlling_Function_Wrappers): Create wrappers for constructor
	functions that need it, even when not marked Requires_Overriding.
	Improve warnings for in out parameters
	(Analyze_Function_Return): Warn for disallowed null return
	Warn on return from procedure with unset out parameter
	Ensure consistent use of # in error messages
	(Check_Overriding_Indicator): Add in parameter Is_Primitive.
	(Analyze_Function_Return): Move call to Apply_Constraint_Check before
	the implicit conversion of the expression done for anonymous access
	types. This is required to generate the code of the null excluding
	check (if required).

	* sem_warn.ads, sem_warn.adb (Check_References.Publicly_Referenceable):
	A formal parameter is never publicly referenceable outside of its body.
	(Check_References): For an unreferenced formal parameter in an accept
	statement, use the same warning circuitry as for subprogram formal
	parameters.
	(Warn_On_Unreferenced_Entity): New subprogram, taken from
	Output_Unreferenced_Messages, containing the part of that routine that
	is now reused for entry formals as described above.
	(Goto_Spec_Entity): New function
	(Check_References): Do not give IN OUT warning for dispatching operation
	Improve warnings for in out parameters
	(Test_Ref): Check that the entity is not undefinite before calling
	Scope_Within, in order to avoid infinite loops.
	Warn on return from procedure with unset out parameter
	Improved warnings for unused variables

From-SVN: r127415

gcc/ada/einfo.adb

@@ -474,15 +474,12 @@ package body Einfo is
    --    Has_Up_Level_Access             Flag215
    --    Universal_Aliasing              Flag216
    --    Suppress_Value_Tracking_On_Call Flag217
+   --    Is_Primitive                    Flag218
+   --    Has_Initial_Value               Flag219
+   --    Has_Dispatch_Table              Flag220
 
-   --    (unused)                        Flag77
-
-   --    (unused)                        Flag218
-   --    (unused)                        Flag219
-   --    (unused)                        Flag220
-
-   --    (unused)                        Flag221
-   --    (unused)                        Flag222
+   --    Has_Pragma_Preelab_Init         Flag221
+   --    Used_As_Generic_Actual          Flag222
    --    (unused)                        Flag223
    --    (unused)                        Flag224
    --    (unused)                        Flag225
@@ -1194,6 +1191,12 @@ package body Einfo is
       return Flag5 (Id);
    end Has_Discriminants;
 
+   function Has_Dispatch_Table (Id : E) return B is
+   begin
+      pragma Assert (Is_Tagged_Type (Id));
+      return Flag220 (Id);
+   end Has_Dispatch_Table;
+
    function Has_Enumeration_Rep_Clause (Id : E) return B is
    begin
       pragma Assert (Is_Enumeration_Type (Id));
@@ -1231,6 +1234,13 @@ package body Einfo is
       return Flag56 (Id);
    end Has_Homonym;
 
+   function Has_Initial_Value (Id : E) return B is
+   begin
+      pragma Assert
+        (Ekind (Id) = E_Variable or else Is_Formal (Id));
+      return Flag219 (Id);
+   end Has_Initial_Value;
+
    function Has_Machine_Radix_Clause (Id : E) return B is
    begin
       pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
@@ -1297,6 +1307,11 @@ package body Einfo is
       return Flag121 (Implementation_Base_Type (Id));
    end Has_Pragma_Pack;
 
+   function Has_Pragma_Preelab_Init (Id : E) return B is
+   begin
+      return Flag221 (Id);
+   end Has_Pragma_Preelab_Init;
+
    function Has_Pragma_Pure (Id : E) return B is
    begin
       return Flag203 (Id);
@@ -1830,6 +1845,15 @@ package body Einfo is
       return Flag59 (Id);
    end Is_Preelaborated;
 
+   function Is_Primitive (Id : E) return B is
+   begin
+      pragma Assert
+        (Is_Overloadable (Id)
+         or else Ekind (Id) = E_Generic_Function
+         or else Ekind (Id) = E_Generic_Procedure);
+      return Flag218 (Id);
+   end Is_Primitive;
+
    function Is_Primitive_Wrapper (Id : E) return B is
    begin
       pragma Assert (Ekind (Id) = E_Procedure);
@@ -2297,7 +2321,8 @@ package body Einfo is
 
    function Related_Interface (Id : E) return E is
    begin
-      pragma Assert (Ekind (Id) = E_Component);
+      pragma Assert
+        (Ekind (Id) = E_Component or else Ekind (Id) = E_Constant);
       return Node26 (Id);
    end Related_Interface;
 
@@ -2506,6 +2531,11 @@ package body Einfo is
       return Node16 (Id);
    end Unset_Reference;
 
+   function Used_As_Generic_Actual (Id : E) return B is
+   begin
+      return Flag222 (Id);
+   end Used_As_Generic_Actual;
+
    function Uses_Sec_Stack (Id : E) return B is
    begin
       return Flag95 (Id);
@@ -3428,6 +3458,13 @@ package body Einfo is
       Set_Flag5 (Id, V);
    end Set_Has_Discriminants;
 
+   procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_Record_Type
+        and then Is_Tagged_Type (Id));
+      Set_Flag220 (Id, V);
+   end Set_Has_Dispatch_Table;
+
    procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Enumeration_Type (Id));
@@ -3465,6 +3502,13 @@ package body Einfo is
       Set_Flag56 (Id, V);
    end Set_Has_Homonym;
 
+   procedure Set_Has_Initial_Value (Id : E; V : B := True) is
+   begin
+      pragma Assert
+        (Ekind (Id) = E_Variable or else Ekind (Id) = E_Out_Parameter);
+      Set_Flag219 (Id, V);
+   end Set_Has_Initial_Value;
+
    procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
@@ -3542,6 +3586,11 @@ package body Einfo is
       Set_Flag121 (Id, V);
    end Set_Has_Pragma_Pack;
 
+   procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True) is
+   begin
+      Set_Flag221 (Id, V);
+   end Set_Has_Pragma_Preelab_Init;
+
    procedure Set_Has_Pragma_Pure (Id : E; V : B := True) is
    begin
       Set_Flag203 (Id, V);
@@ -4097,6 +4146,15 @@ package body Einfo is
       Set_Flag59 (Id, V);
    end Set_Is_Preelaborated;
 
+   procedure Set_Is_Primitive (Id : E; V : B := True) is
+   begin
+      pragma Assert
+        (Is_Overloadable (Id)
+         or else Ekind (Id) = E_Generic_Function
+         or else Ekind (Id) = E_Generic_Procedure);
+      Set_Flag218 (Id, V);
+   end Set_Is_Primitive;
+
    procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
    begin
       pragma Assert (Ekind (Id) = E_Procedure);
@@ -4574,7 +4632,8 @@ package body Einfo is
 
    procedure Set_Related_Interface (Id : E; V : E) is
    begin
-      pragma Assert (Ekind (Id) = E_Component);
+      pragma Assert
+        (Ekind (Id) = E_Component or else Ekind (Id) = E_Constant);
       Set_Node26 (Id, V);
    end Set_Related_Interface;
 
@@ -4793,6 +4852,11 @@ package body Einfo is
       Set_Flag95 (Id, V);
    end Set_Uses_Sec_Stack;
 
+   procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
+   begin
+      Set_Flag222 (Id, V);
+   end Set_Used_As_Generic_Actual;
+
    procedure Set_Vax_Float (Id : E; V : B := True) is
    begin
       pragma Assert (Id = Base_Type (Id));
@@ -4918,7 +4982,7 @@ package body Einfo is
    begin
       Set_Uint8  (Id, No_Uint);  -- Normalized_First_Bit
       Set_Uint10 (Id, No_Uint);  -- Normalized_Position_Max
-      Set_Uint11 (Id, No_Uint);  -- Component_First_Bit
+      Set_Uint11 (Id, No_Uint);  -- Component_Bit_Offset
       Set_Uint12 (Id, Uint_0);   -- Esize
       Set_Uint14 (Id, No_Uint);  -- Normalized_Position
    end Init_Component_Location;
@@ -5161,7 +5225,10 @@ package body Einfo is
       if Is_Incomplete_Type (Id)
         and then Present (Non_Limited_View (Id))
       then
-         return Non_Limited_View (Id);
+         --  The non-limited view may itself be an incomplete type, in
+         --  which case get its full view.
+
+         return Get_Full_View (Non_Limited_View (Id));
 
       elsif Is_Class_Wide_Type (Id)
         and then Is_Incomplete_Type (Etype (Id))
@@ -5327,7 +5394,6 @@ package body Einfo is
             P := Parent (P);
          end if;
       end loop;
-
    end Declaration_Node;
 
    ---------------------
@@ -5681,6 +5747,28 @@ package body Einfo is
       return Empty;
    end Get_Attribute_Definition_Clause;
 
+   -------------------
+   -- Get_Full_View --
+   -------------------
+
+   function Get_Full_View (T : Entity_Id) return Entity_Id is
+   begin
+      if Ekind (T) = E_Incomplete_Type
+        and then Present (Full_View (T))
+      then
+         return Full_View (T);
+
+      elsif Is_Class_Wide_Type (T)
+        and then Ekind (Root_Type (T)) = E_Incomplete_Type
+        and then Present (Full_View (Root_Type (T)))
+      then
+         return Class_Wide_Type (Full_View (Root_Type (T)));
+
+      else
+         return T;
+      end if;
+   end Get_Full_View;
+
    --------------------
    -- Get_Rep_Pragma --
    --------------------
@@ -6565,6 +6653,11 @@ package body Einfo is
       elsif Ekind (T) = E_Class_Wide_Subtype then
          return Etype (Base_Type (T));
 
+         --  ??? T comes from Base_Type, how can it be a subtype?
+         --  Also Base_Type is supposed to be idempotent, so either way
+         --  this is equivalent to "return Etype (T)" and should be merged
+         --  with the E_Class_Wide_Type case.
+
       --  All other cases
 
       else
@@ -7007,6 +7100,7 @@ package body Einfo is
       W ("Has_Fully_Qualified_Name",        Flag173 (Id));
       W ("Has_Gigi_Rep_Item",               Flag82  (Id));
       W ("Has_Homonym",                     Flag56  (Id));
+      W ("Has_Initial_Value",               Flag219 (Id));
       W ("Has_Machine_Radix_Clause",        Flag83  (Id));
       W ("Has_Master_Entity",               Flag21  (Id));
       W ("Has_Missing_Return",              Flag142 (Id));
@@ -7019,6 +7113,7 @@ package body Einfo is
       W ("Has_Pragma_Elaborate_Body",       Flag150 (Id));
       W ("Has_Pragma_Inline",               Flag157 (Id));
       W ("Has_Pragma_Pack",                 Flag121 (Id));
+      W ("Has_Pragma_Preelab_Init",         Flag221 (Id));
       W ("Has_Pragma_Pure",                 Flag203 (Id));
       W ("Has_Pragma_Pure_Function",        Flag179 (Id));
       W ("Has_Pragma_Unreferenced",         Flag180 (Id));
@@ -7172,8 +7267,10 @@ package body Einfo is
       W ("Suppress_Init_Proc",              Flag105 (Id));
       W ("Suppress_Style_Checks",           Flag165 (Id));
       W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
+      W ("Is_Primitive",                    Flag218 (Id));
       W ("Treat_As_Volatile",               Flag41  (Id));
       W ("Universal_Aliasing",              Flag216 (Id));
+      W ("Used_As_Generic_Actual",          Flag222 (Id));
       W ("Uses_Sec_Stack",                  Flag95  (Id));
       W ("Vax_Float",                       Flag151 (Id));
       W ("Warnings_Off",                    Flag96  (Id));
@@ -7741,9 +7838,9 @@ package body Einfo is
       end case;
    end Write_Field17_Name;
 
-   -----------------------
+   ------------------------
    -- Write_Field18_Name --
-   -----------------------
+   ------------------------
 
    procedure Write_Field18_Name (Id : Entity_Id) is
    begin
@@ -7770,8 +7867,7 @@ package body Einfo is
          when Fixed_Point_Kind                             =>
             Write_Str ("Delta_Value");
 
-         when E_Constant                                   |
-              E_Variable                                   =>
+         when Object_Kind                                  =>
             Write_Str ("Renamed_Object");
 
          when E_Exception                                  |
@@ -8114,7 +8210,8 @@ package body Einfo is
    procedure Write_Field26_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
-         when E_Component                                  =>
+         when E_Component                                  |
+              E_Constant                                   =>
             Write_Str ("Related_Interface");
 
          when E_Generic_Package                            |

gcc/ada/einfo.ads

@@ -193,7 +193,7 @@ package Einfo is
 --    Object_Size of this first-named subtype to the given value padded up
 --    to an appropriate boundary. It is a consequence of the default rules
 --    above that this Object_Size will apply to all further subtypes. On the
---    otyher hand, Value_Size is affected only for the first subtype, any
+--    other hand, Value_Size is affected only for the first subtype, any
 --    dynamic subtypes obtained from it directly, and any statically matching
 --    subtypes. The Value_Size of any other static subtypes is not affected.
 
@@ -245,6 +245,10 @@ package Einfo is
 --  and Value_Size are the same (and equivalent to the RM attribute Size).
 --  Only Size may be specified for such types.
 
+--  All size attributes are stored as Uint values. Negative values are used to
+--  reference GCC expressions for the case of non-static sizes, as explained
+--  in Repinfo.
+
 -----------------------
 -- Entity Attributes --
 -----------------------
@@ -347,7 +351,8 @@ package Einfo is
 --       Present in all entities. Set if the Address or Unrestricted_Access
 --       attribute is applied directly to the entity, i.e. the entity is the
 --       entity of the prefix of the attribute reference. Used by Gigi to
---       make sure that the address can be meaningfully taken.
+--       make sure that the address can be meaningfully taken, and also in
+--       the case of subprograms to control output of certain warnings.
 
 --    Alias (Node18)
 --       Present in overloaded entities (literals, subprograms, entries) and
@@ -1388,6 +1393,14 @@ package Einfo is
 --       and incomplete types), indicates if the corresponding type or subtype
 --       has a known discriminant part. Always false for all other types.
 
+--    Has_Dispatch_Table (Flag220)
+--       Present in E_Record_Types that are tagged. Set to indicate that the
+--       corresponding dispatch table is already built. This flag is used to
+--       avoid duplicate construction of library level dispatch tables (because
+--       the declaration of library level objects cause premature construction
+--       of the table); otherwise the code that builds the table is added at
+--       the end of the list of declarations of the package.
+
 --    Has_Entries (synthesized)
 --       Applies to concurrent types. True if any entries are declared
 --       within the task or protected definition for the type.
@@ -1446,7 +1459,16 @@ package Einfo is
 --    Has_Homonym (Flag56)
 --       Present in all entities. Set if an entity has a homonym in the same
 --       scope. Used by Gigi to generate unique names for such entities.
-
+--
+--    Has_Initial_Value (Flag219)
+--       Present in entities for variables and out parameters. Set if there
+--       is an explicit initial value expression in the declaration of the
+--       variable. Note that this is set only if this initial value is
+--       explicit, it is not set for the case of implicit initialization
+--       of access types or controlled types. Always set to False for out
+--       parameters. Also present in entities for in and in-out parameters,
+--       but always false in these cases.
+--
 --    Has_Interrupt_Handler (synthesized)
 --       Applies to all protected type entities. Set if the protected type
 --       definition contains at least one procedure to which a pragma
@@ -1546,6 +1568,10 @@ package Einfo is
 --       was given for the entity. In some cases, we need to test whether
 --       Is_Pure was explicitly set using this pragma.
 
+--    Has_Pragma_Preelab_Init (Flag221)
+--       Present in type and subtype entities. If set indicates that a valid
+--       pragma Preelaborable_Initialization applies to the type.
+
 --    Has_Pragma_Pure_Function (Flag179)
 --       Present in all entities. If set, indicates that a valid pragma
 --       Pure_Function was given for the entity. In some cases, we need to
@@ -2144,9 +2170,12 @@ package Einfo is
 --    Is_Internal (Flag17)
 --       Present in all entities. Set to indicate an entity created during
 --       semantic processing (e.g. an implicit type, or a temporary). The
---       only current use of this flag is to indicate that temporaries
+--       current uses of this flag are: 1) to indicate that temporaries
 --       generated for the result of an inlined function call need not be
---       initialized, even when scalars are initialized or normalized.
+--       initialized, even when scalars are initialized or normalized, and
+--       2) to indicate object declarations generated by the expander that are
+--       implicitly imported or exported, so that they can be appropriately
+--       marked in Sprint output.
 
 --    Is_Interrupt_Handler (Flag89)
 --       Present in procedures. Set if a pragma Interrupt_Handler applies
@@ -2388,6 +2417,12 @@ package Einfo is
 --       flag is set does not necesarily mean that no elaboration code is
 --       generated for the package.
 
+--    Is_Primitive (Flag218)
+--       Present in overloadable entities and in generic subprograms. Set to
+--       indicate that this is a primitive operation of some type, which may be
+--       a tagged type or a non-tagged type. Used to verify overriding
+--       indicators in bodies.
+
 --    Is_Primitive_Wrapper (Flag195)
 --       Present in E_Procedures. Primitive wrappers are Expander-generated
 --       procedures that wrap entries of protected or task types implementing
@@ -2757,13 +2792,15 @@ package Einfo is
 --       entities when the return type is an array type, and a call can be
 --       interpreted as an indexing of the result of the call. It is also
 --       used to resolve various cases of entry calls.
-
+--
 --    Never_Set_In_Source (Flag115)
 --       Present in all entities, but relevant only for variables and
---       parameters. This flag is set if the object is never assigned
---       a value in user source code, either by assignment or by the
---       use of an initial value, or by some other means.
-
+--       parameters. This flag is set if the object is never assigned a value
+--       in user source code, either by assignment or by being used as an out
+--       or in out parameter. Note that this flag is not reset from using an
+--       initial value, so if you want to test for this case as well, test the
+--       Has_Initial_Value flag also.
+--
 --       This flag is only for the purposes of issuing warnings, it must not
 --       be used by the code generator to indicate that the variable is in
 --       fact a constant, since some assignments in generated code do not
@@ -3095,15 +3132,15 @@ package Einfo is
 
 --    Referenced (Flag156)
 --       Present in all entities, set if the entity is referenced, except
---       for the case of an appearence of a simple variable that is not a
+--       for the case of an appearence of a simple variable, that is not a
 --       renaming, as the left side of an assignment in which case the flag
 --       Referenced_As_LHS is set instead.
 
---    Referenced_As_LHS (Flag36): This flag is set instead of
---       Referenced if a simple variable that is not a renaming appears as
---       the left side of an assignment. The reason we distinguish this kind
---       of reference is that we have a separate warning for variables that
---       are only assigned and never read.
+--    Referenced_As_LHS (Flag36):
+--       This flag is set instead of Referenced if a simple variable that is
+--       not a renaming appears as the left side of an assignment. The reason
+--       we distinguish this kind of reference is that we have a separate
+--       warning for variables that are only assigned and never read.
 
 --    Referenced_Object (Node10)
 --       Present in all type entities. Set non-Empty only for type entities
@@ -3132,9 +3169,8 @@ package Einfo is
 --       must correspond to the name and scope of the related instance.
 
 --    Related_Interface (Node26)
---       Present in components associated with secondary dispatch tables
---       (dispatch table pointers and offset components). Set to point to the
---       entity of the corresponding interface type.
+--       Present in components and constants associated with dispatch tables.
+--       Set to point to the entity of the associated interface type.
 
 --    Renamed_Entity (Node18)
 --       Present in exceptions, packages, subprograms and generic units. Set
@@ -3144,15 +3180,16 @@ package Einfo is
 
 --    Renamed_Object (Node18)
 --       Present in all objects (constants, variables, components, formal
---       parameters, generic formal parameters, and loop parameters). Set
---       non-Empty if the object was declared by a renaming declaration, in
---       which case it references the tree node for the name of the renamed
+--       parameters, generic formal parameters, and loop parameters).
+--       ??? Present in discriminants?
+--       Set non-Empty if the object was declared by a renaming declaration,
+--       in which case it references the tree node for the name of the renamed
 --       object. This is only possible for the variable and constant cases.
 --       For formal parameters, this field is used in the course of inline
 --       expansion, to map the formals of a subprogram into the corresponding
 --       actuals. For formals of a task entry, it denotes the local renaming
---       that replaces the actual within the accept statement.
---       The field is Empty otherwise.
+--       that replaces the actual within the accept statement. The field is
+--       Empty otherwise (it is always empty for loop parameters).
 
 --    Renaming_Map (Uint9)
 --       Present in generic subprograms, generic packages, and their
@@ -3474,6 +3511,10 @@ package Einfo is
 --       is identified. This field is used to generate a warning message if
 --       necessary (see Sem_Warn.Check_Unset_Reference).
 
+--    Used_As_Generic_Actual (Flag222)
+--       Present in all entities, set if the entity is used as an argument to
+--       a generic instantiation. Used to tune certain warning messages.
+
 --    Uses_Sec_Stack (Flag95)
 --       Present in scope entities (blocks,functions, procedures, tasks,
 --       entries). Set to True when secondary stack is used in this scope and
@@ -4085,7 +4126,7 @@ package Einfo is
    subtype Formal_Kind                 is Entity_Kind range
        E_In_Parameter ..
    --  E_Out_Parameter
-     E_In_Out_Parameter;
+       E_In_Out_Parameter;
 
    subtype Formal_Object_Kind          is Entity_Kind range
        E_Generic_In_Out_Parameter ..
@@ -4364,6 +4405,7 @@ package Einfo is
    --    Suppress_Elaboration_Warnings       (Flag148)
    --    Suppress_Style_Checks               (Flag165)
    --    Suppress_Value_Tracking_On_Call     (Flag217)
+   --    Used_As_Generic_Actual              (Flag222)
    --    Was_Hidden                          (Flag196)
 
    --    Declaration_Node                    (synth)
@@ -4400,6 +4442,7 @@ package Einfo is
    --    Has_Discriminants                   (Flag5)
    --    Has_Non_Standard_Rep                (Flag75)   (base type only)
    --    Has_Object_Size_Clause              (Flag172)
+   --    Has_Pragma_Preelab_Init             (Flag221)
    --    Has_Pragma_Unreferenced_Objects     (Flag212)
    --    Has_Primitive_Operations            (Flag120)  (base type only)
    --    Has_Size_Clause                     (Flag29)
@@ -4587,8 +4630,8 @@ package Einfo is
    --    Actual_Subtype                      (Node17)
    --    Renamed_Object                      (Node18)
    --    Size_Check_Code                     (Node19)   (constants only)
-   --    In_Private_Part                     (Flag45)
    --    Interface_Name                      (Node21)
+   --    Related_Interface                   (Node26)   (constants only)
    --    Has_Alignment_Clause                (Flag46)
    --    Has_Atomic_Components               (Flag86)
    --    Has_Biased_Representation           (Flag139)
@@ -4596,6 +4639,7 @@ package Einfo is
    --    Has_Size_Clause                     (Flag29)
    --    Has_Up_Level_Access                 (Flag215)
    --    Has_Volatile_Components             (Flag87)
+   --    In_Private_Part                     (Flag45)
    --    Is_Atomic                           (Flag85)
    --    Is_Eliminated                       (Flag124)
    --    Is_True_Constant                    (Flag163)
@@ -4763,6 +4807,7 @@ package Einfo is
    --    Is_Intrinsic_Subprogram             (Flag64)
    --    Is_Machine_Code_Subprogram          (Flag137)  (non-generic case only)
    --    Is_Overriding_Operation             (Flag39)   (non-generic case only)
+   --    Is_Primitive                        (Flag218)
    --    Is_Private_Descendant               (Flag53)
    --    Is_Pure                             (Flag44)
    --    Is_Visible_Child_Unit               (Flag116)
@@ -4828,6 +4873,7 @@ package Einfo is
    --    Default_Expr_Function               (Node21)
    --    Protected_Formal                    (Node22)
    --    Extra_Constrained                   (Node23)
+   --    Has_Initial_Value                   (Flag219)
    --    Is_Controlling_Formal               (Flag97)
    --    Is_Entry_Formal                     (Flag52)
    --    Is_Optional_Parameter               (Flag134)
@@ -4884,6 +4930,7 @@ package Einfo is
    --    Is_Pure                             (Flag44)
    --    Is_Intrinsic_Subprogram             (Flag64)
    --    Is_Overriding_Operation             (Flag39)
+   --    Is_Primitive                        (Flag218)
    --    Default_Expressions_Processed       (Flag108)
 
    --  E_Ordinary_Fixed_Point_Type
@@ -5018,6 +5065,7 @@ package Einfo is
    --    Is_Machine_Code_Subprogram          (Flag137)  (non-generic case only)
    --    Is_Null_Init_Proc                   (Flag178)
    --    Is_Overriding_Operation             (Flag39)   (non-generic case only)
+   --    Is_Primitive                        (Flag218)
    --    Is_Primitive_Wrapper                (Flag195)  (non-generic case only)
    --    Is_Private_Descendant               (Flag53)
    --    Is_Pure                             (Flag44)
@@ -5073,6 +5121,7 @@ package Einfo is
    --    Abstract_Interfaces                 (Elist25)
    --    Component_Alignment                 (special)  (base type only)
    --    C_Pass_By_Copy                      (Flag125)  (base type only)
+   --    Has_Dispatch_Table                  (Flag220)  (base tagged type only)
    --    Has_External_Tag_Rep_Clause         (Flag110)
    --    Has_Record_Rep_Clause               (Flag65)   (base type only)
    --    Has_Static_Discriminants            (Flag211)  (subtype only)
@@ -5204,6 +5253,7 @@ package Einfo is
    --    Has_Alignment_Clause                (Flag46)
    --    Has_Atomic_Components               (Flag86)
    --    Has_Biased_Representation           (Flag139)
+   --    Has_Initial_Value                   (Flag219)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Volatile_Components             (Flag87)
    --    In_Private_Part                     (Flag45)
@@ -5562,12 +5612,14 @@ package Einfo is
    function Has_Convention_Pragma               (Id : E) return B;
    function Has_Delayed_Freeze                  (Id : E) return B;
    function Has_Discriminants                   (Id : E) return B;
+   function Has_Dispatch_Table                  (Id : E) return B;
    function Has_Enumeration_Rep_Clause          (Id : E) return B;
    function Has_Exit                            (Id : E) return B;
    function Has_External_Tag_Rep_Clause         (Id : E) return B;
    function Has_Fully_Qualified_Name            (Id : E) return B;
    function Has_Gigi_Rep_Item                   (Id : E) return B;
    function Has_Homonym                         (Id : E) return B;
+   function Has_Initial_Value                   (Id : E) return B;
    function Has_Interrupt_Handler               (Id : E) return B;
    function Has_Machine_Radix_Clause            (Id : E) return B;
    function Has_Master_Entity                   (Id : E) return B;
@@ -5583,6 +5635,7 @@ package Einfo is
    function Has_Pragma_Elaborate_Body           (Id : E) return B;
    function Has_Pragma_Inline                   (Id : E) return B;
    function Has_Pragma_Pack                     (Id : E) return B;
+   function Has_Pragma_Preelab_Init             (Id : E) return B;
    function Has_Pragma_Pure                     (Id : E) return B;
    function Has_Pragma_Pure_Function            (Id : E) return B;
    function Has_Pragma_Unreferenced             (Id : E) return B;
@@ -5673,6 +5726,7 @@ package Einfo is
    function Is_Packed_Array_Type                (Id : E) return B;
    function Is_Potentially_Use_Visible          (Id : E) return B;
    function Is_Preelaborated                    (Id : E) return B;
+   function Is_Primitive                        (Id : E) return B;
    function Is_Primitive_Wrapper                (Id : E) return B;
    function Is_Private_Composite                (Id : E) return B;
    function Is_Private_Descendant               (Id : E) return B;
@@ -5790,6 +5844,7 @@ package Einfo is
    function Underlying_Full_View                (Id : E) return E;
    function Universal_Aliasing                  (Id : E) return B;
    function Unset_Reference                     (Id : E) return N;
+   function Used_As_Generic_Actual              (Id : E) return B;
    function Uses_Sec_Stack                      (Id : E) return B;
    function Vax_Float                           (Id : E) return B;
    function Warnings_Off                        (Id : E) return B;
@@ -6088,12 +6143,14 @@ package Einfo is
    procedure Set_Has_Convention_Pragma           (Id : E; V : B := True);
    procedure Set_Has_Delayed_Freeze              (Id : E; V : B := True);
    procedure Set_Has_Discriminants               (Id : E; V : B := True);
+   procedure Set_Has_Dispatch_Table              (Id : E; V : B := True);
    procedure Set_Has_Enumeration_Rep_Clause      (Id : E; V : B := True);
    procedure Set_Has_Exit                        (Id : E; V : B := True);
    procedure Set_Has_External_Tag_Rep_Clause     (Id : E; V : B := True);
    procedure Set_Has_Fully_Qualified_Name        (Id : E; V : B := True);
    procedure Set_Has_Gigi_Rep_Item               (Id : E; V : B := True);
    procedure Set_Has_Homonym                     (Id : E; V : B := True);
+   procedure Set_Has_Initial_Value               (Id : E; V : B := True);
    procedure Set_Has_Machine_Radix_Clause        (Id : E; V : B := True);
    procedure Set_Has_Master_Entity               (Id : E; V : B := True);
    procedure Set_Has_Missing_Return              (Id : E; V : B := True);
@@ -6108,6 +6165,7 @@ package Einfo is
    procedure Set_Has_Pragma_Elaborate_Body       (Id : E; V : B := True);
    procedure Set_Has_Pragma_Inline               (Id : E; V : B := True);
    procedure Set_Has_Pragma_Pack                 (Id : E; V : B := True);
+   procedure Set_Has_Pragma_Preelab_Init         (Id : E; V : B := True);
    procedure Set_Has_Pragma_Pure                 (Id : E; V : B := True);
    procedure Set_Has_Pragma_Pure_Function        (Id : E; V : B := True);
    procedure Set_Has_Pragma_Unreferenced         (Id : E; V : B := True);
@@ -6205,6 +6263,7 @@ package Einfo is
    procedure Set_Is_Packed_Array_Type            (Id : E; V : B := True);
    procedure Set_Is_Potentially_Use_Visible      (Id : E; V : B := True);
    procedure Set_Is_Preelaborated                (Id : E; V : B := True);
+   procedure Set_Is_Primitive                    (Id : E; V : B := True);
    procedure Set_Is_Primitive_Wrapper            (Id : E; V : B := True);
    procedure Set_Is_Private_Composite            (Id : E; V : B := True);
    procedure Set_Is_Private_Descendant           (Id : E; V : B := True);
@@ -6322,6 +6381,7 @@ package Einfo is
    procedure Set_Underlying_Full_View            (Id : E; V : E);
    procedure Set_Universal_Aliasing              (Id : E; V : B := True);
    procedure Set_Unset_Reference                 (Id : E; V : N);
+   procedure Set_Used_As_Generic_Actual          (Id : E; V : B := True);
    procedure Set_Uses_Sec_Stack                  (Id : E; V : B := True);
    procedure Set_Vax_Float                       (Id : E; V : B := True);
    procedure Set_Warnings_Off                    (Id : E; V : B := True);
@@ -6353,6 +6413,11 @@ package Einfo is
    --  This is particularly true for the RM_Size field, where a value of zero
    --  is legitimate and causes some kludges around the code.
 
+   --  Contrary to the corresponding Set procedures above, these routines
+   --  do NOT check the entity kind of their argument, instead they set the
+   --  underlying Uint fields directly (this allows them to be used for
+   --  entities whose Ekind has not been set yet).
+
    procedure Init_Alignment                (Id : E; V : Int);
    procedure Init_Component_Size           (Id : E; V : Int);
    procedure Init_Component_Bit_Offset     (Id : E; V : Int);
@@ -6489,6 +6554,11 @@ package Einfo is
    procedure Append_Entity (Id : Entity_Id; V : Entity_Id);
    --  Add an entity to the list of entities declared in the scope V
 
+   function Get_Full_View (T : Entity_Id) return Entity_Id;
+   --  If T is an incomplete type and the full declaration has been
+   --  seen, or is the name of a class_wide type whose root is incomplete.
+   --  return the corresponding full declaration.
+
    function Is_Entity_Name (N : Node_Id) return Boolean;
    --  Test if the node N is the name of an entity (i.e. is an identifier,
    --  expanded name, or an attribute reference that returns an entity).
@@ -6666,12 +6736,14 @@ package Einfo is
    pragma Inline (Has_Convention_Pragma);
    pragma Inline (Has_Delayed_Freeze);
    pragma Inline (Has_Discriminants);
+   pragma Inline (Has_Dispatch_Table);
    pragma Inline (Has_Enumeration_Rep_Clause);
    pragma Inline (Has_Exit);
    pragma Inline (Has_External_Tag_Rep_Clause);
    pragma Inline (Has_Fully_Qualified_Name);
    pragma Inline (Has_Gigi_Rep_Item);
    pragma Inline (Has_Homonym);
+   pragma Inline (Has_Initial_Value);
    pragma Inline (Has_Machine_Radix_Clause);
    pragma Inline (Has_Master_Entity);
    pragma Inline (Has_Missing_Return);
@@ -6685,6 +6757,7 @@ package Einfo is
    pragma Inline (Has_Pragma_Elaborate_Body);
    pragma Inline (Has_Pragma_Inline);
    pragma Inline (Has_Pragma_Pack);
+   pragma Inline (Has_Pragma_Preelab_Init);
    pragma Inline (Has_Pragma_Pure);
    pragma Inline (Has_Pragma_Pure_Function);
    pragma Inline (Has_Pragma_Unreferenced);
@@ -6812,6 +6885,7 @@ package Einfo is
    pragma Inline (Is_Packed_Array_Type);
    pragma Inline (Is_Potentially_Use_Visible);
    pragma Inline (Is_Preelaborated);
+   pragma Inline (Is_Primitive);
    pragma Inline (Is_Primitive_Wrapper);
    pragma Inline (Is_Private_Composite);
    pragma Inline (Is_Private_Descendant);
@@ -6940,6 +7014,7 @@ package Einfo is
    pragma Inline (Underlying_Full_View);
    pragma Inline (Universal_Aliasing);
    pragma Inline (Unset_Reference);
+   pragma Inline (Used_As_Generic_Actual);
    pragma Inline (Uses_Sec_Stack);
    pragma Inline (Vax_Float);
    pragma Inline (Warnings_Off);
@@ -7061,12 +7136,14 @@ package Einfo is
    pragma Inline (Set_Has_Convention_Pragma);
    pragma Inline (Set_Has_Delayed_Freeze);
    pragma Inline (Set_Has_Discriminants);
+   pragma Inline (Set_Has_Dispatch_Table);
    pragma Inline (Set_Has_Enumeration_Rep_Clause);
    pragma Inline (Set_Has_Exit);
    pragma Inline (Set_Has_External_Tag_Rep_Clause);
    pragma Inline (Set_Has_Fully_Qualified_Name);
    pragma Inline (Set_Has_Gigi_Rep_Item);
    pragma Inline (Set_Has_Homonym);
+   pragma Inline (Set_Has_Initial_Value);
    pragma Inline (Set_Has_Machine_Radix_Clause);
    pragma Inline (Set_Has_Master_Entity);
    pragma Inline (Set_Has_Missing_Return);
@@ -7080,6 +7157,7 @@ package Einfo is
    pragma Inline (Set_Has_Pragma_Elaborate_Body);
    pragma Inline (Set_Has_Pragma_Inline);
    pragma Inline (Set_Has_Pragma_Pack);
+   pragma Inline (Set_Has_Pragma_Preelab_Init);
    pragma Inline (Set_Has_Pragma_Pure);
    pragma Inline (Set_Has_Pragma_Pure_Function);
    pragma Inline (Set_Has_Pragma_Unreferenced);
@@ -7178,6 +7256,7 @@ package Einfo is
    pragma Inline (Set_Is_Packed_Array_Type);
    pragma Inline (Set_Is_Potentially_Use_Visible);
    pragma Inline (Set_Is_Preelaborated);
+   pragma Inline (Set_Is_Primitive);
    pragma Inline (Set_Is_Primitive_Wrapper);
    pragma Inline (Set_Is_Private_Composite);
    pragma Inline (Set_Is_Private_Descendant);
@@ -7295,6 +7374,7 @@ package Einfo is
    pragma Inline (Set_Underlying_Full_View);
    pragma Inline (Set_Universal_Aliasing);
    pragma Inline (Set_Unset_Reference);
+   pragma Inline (Set_Used_As_Generic_Actual);
    pragma Inline (Set_Uses_Sec_Stack);
    pragma Inline (Set_Vax_Float);
    pragma Inline (Set_Warnings_Off);

gcc/ada/sem_ch6.adb

@@ -80,12 +80,6 @@ with Validsw;  use Validsw;
 
 package body Sem_Ch6 is
 
-   Enable_New_Return_Processing : constant Boolean := True;
-   --  ??? This flag is temporary. False causes the compiler to use the old
-   --  version of Analyze_Return_Statement; True, the new version, which does
-   --  not yet work. You probably want this to match the corresponding thing
-   --  in exp_ch5.adb.
-
    May_Hide_Profile : Boolean := False;
    --  This flag is used to indicate that two formals in two subprograms being
    --  checked for conformance differ only in that one is an access parameter
@@ -99,11 +93,11 @@ package body Sem_Ch6 is
    -- Local Subprograms --
    -----------------------
 
-   procedure Analyze_A_Return_Statement (N : Node_Id);
+   procedure Analyze_Return_Statement (N : Node_Id);
    --  Common processing for simple_ and extended_return_statements
 
    procedure Analyze_Function_Return (N : Node_Id);
-   --  Subsidiary to Analyze_A_Return_Statement.
+   --  Subsidiary to Analyze_Return_Statement.
    --  Called when the return statement applies to a [generic] function.
 
    procedure Analyze_Return_Type (N : Node_Id);
@@ -147,11 +141,13 @@ package body Sem_Ch6 is
 
    procedure Check_Overriding_Indicator
      (Subp            : Entity_Id;
-      Overridden_Subp : Entity_Id := Empty);
+      Overridden_Subp : Entity_Id;
+      Is_Primitive    : Boolean);
    --  Verify the consistency of an overriding_indicator given for subprogram
-   --  declaration, body, renaming, or instantiation. Overridden_Subp is set
-   --  if the scope into which we are introducing the subprogram contains a
+   --  declaration, body, renaming, or instantiation.  Overridden_Subp is set
+   --  if the scope where we are introducing the subprogram contains a
    --  type-conformant subprogram that becomes hidden by the new subprogram.
+   --  Is_Primitive indicates whether the subprogram is primitive.
 
    procedure Check_Subprogram_Order (N : Node_Id);
    --  N is the N_Subprogram_Body node for a subprogram. This routine applies
@@ -212,36 +208,33 @@ package body Sem_Ch6 is
    --  setting the proper validity status for this entity, which depends
    --  on the kind of parameter and the validity checking mode.
 
-   --------------------------------
-   -- Analyze_A_Return_Statement --
-   --------------------------------
+   ------------------------------
+   -- Analyze_Return_Statement --
+   ------------------------------
 
-   procedure Analyze_A_Return_Statement (N : Node_Id) is
-      --  ???This should be called Analyze_Return_Statement, and
-      --  Analyze_Return_Statement should be called
-      --  Analyze_Simple_Return_Statement!
+   procedure Analyze_Return_Statement (N : Node_Id) is
 
-      pragma Assert (Nkind (N) = N_Return_Statement
-                     or else Nkind (N) = N_Extended_Return_Statement);
+      pragma Assert (Nkind (N) = N_Simple_Return_Statement
+                       or else
+                     Nkind (N) = N_Extended_Return_Statement);
 
       Returns_Object : constant Boolean :=
-        Nkind (N) = N_Extended_Return_Statement
-         or else
-           (Nkind (N) = N_Return_Statement and then Present (Expression (N)));
-
+                         Nkind (N) = N_Extended_Return_Statement
+                           or else
+                            (Nkind (N) = N_Simple_Return_Statement
+                              and then Present (Expression (N)));
       --  True if we're returning something; that is, "return <expression>;"
-      --  or "return Result : T [:= ...]". False for "return;".
-      --  Used for error checking: If Returns_Object is True, N should apply
-      --  to a function body; otherwise N should apply to a procedure body,
-      --  entry body, accept statement, or extended return statement.
+      --  or "return Result : T [:= ...]". False for "return;". Used for error
+      --  checking: If Returns_Object is True, N should apply to a function
+      --  body; otherwise N should apply to a procedure body, entry body,
+      --  accept statement, or extended return statement.
 
       function Find_What_It_Applies_To return Entity_Id;
       --  Find the entity representing the innermost enclosing body, accept
-      --  statement, or extended return statement. If the result is a
-      --  callable construct or extended return statement, then this will be
-      --  the value of the Return_Applies_To attribute. Otherwise, the program
-      --  is illegal. See RM-6.5(4/2). I am disinclined to call this
-      --  Find_The_Construct_To_Which_This_Return_Statement_Applies. ;-)
+      --  statement, or extended return statement. If the result is a callable
+      --  construct or extended return statement, then this will be the value
+      --  of the Return_Applies_To attribute. Otherwise, the program is
+      --  illegal. See RM-6.5(4/2).
 
       -----------------------------
       -- Find_What_It_Applies_To --
@@ -261,41 +254,45 @@ package body Sem_Ch6 is
 
          pragma Assert (Present (Result));
          return Result;
-
       end Find_What_It_Applies_To;
 
+      --  Local declarations
+
       Scope_Id   : constant Entity_Id   := Find_What_It_Applies_To;
       Kind       : constant Entity_Kind := Ekind (Scope_Id);
-
       Loc        : constant Source_Ptr  := Sloc (N);
       Stm_Entity : constant Entity_Id   :=
                      New_Internal_Entity
                        (E_Return_Statement, Current_Scope, Loc, 'R');
 
-   --  Start of processing for Analyze_A_Return_Statement
+   --  Start of processing for Analyze_Return_Statement
 
    begin
-
       Set_Return_Statement_Entity (N, Stm_Entity);
 
       Set_Etype (Stm_Entity, Standard_Void_Type);
       Set_Return_Applies_To (Stm_Entity, Scope_Id);
 
-      --  Place the Return entity on scope stack, to simplify enforcement
-      --  of 6.5 (4/2): an inner return statement will apply to this extended
-      --  return.
+      --  Place Return entity on scope stack, to simplify enforcement of 6.5
+      --  (4/2): an inner return statement will apply to this extended return.
 
       if Nkind (N) = N_Extended_Return_Statement then
          Push_Scope (Stm_Entity);
       end if;
 
-      --  Check that pragma No_Return is obeyed:
+      --  Check that pragma No_Return is obeyed
 
       if No_Return (Scope_Id) then
          Error_Msg_N ("RETURN statement not allowed (No_Return)", N);
       end if;
 
-      --  Check that functions return objects, and other things do not:
+      --  Warn on any unassigned OUT parameters if in procedure
+
+      if Ekind (Scope_Id) = E_Procedure then
+         Warn_On_Unassigned_Out_Parameter (N, Scope_Id);
+      end if;
+
+      --  Check that functions return objects, and other things do not
 
       if Kind = E_Function or else Kind = E_Generic_Function then
          if not Returns_Object then
@@ -340,7 +337,7 @@ package body Sem_Ch6 is
       end if;
 
       Check_Unreachable_Code (N);
-   end Analyze_A_Return_Statement;
+   end Analyze_Return_Statement;
 
    ---------------------------------------------
    -- Analyze_Abstract_Subprogram_Declaration --
@@ -362,6 +359,19 @@ package body Sem_Ch6 is
       if Ekind (Scope (Designator)) = E_Protected_Type then
          Error_Msg_N
            ("abstract subprogram not allowed in protected type", N);
+
+      --  Issue a warning if the abstract subprogram is neither a dispatching
+      --  operation nor an operation that overrides an inherited subprogram or
+      --  predefined operator, since this most likely indicates a mistake.
+
+      elsif Warn_On_Redundant_Constructs
+        and then not Is_Dispatching_Operation (Designator)
+        and then not Is_Overriding_Operation (Designator)
+        and then (not Is_Operator_Symbol_Name (Chars (Designator))
+                   or else Scop /= Scope (Etype (First_Formal (Designator))))
+      then
+         Error_Msg_N
+           ("?abstract subprogram is not dispatching or overriding", N);
       end if;
 
       Generate_Reference_To_Formals (Designator);
@@ -373,7 +383,7 @@ package body Sem_Ch6 is
 
    procedure Analyze_Extended_Return_Statement (N : Node_Id) is
    begin
-      Analyze_A_Return_Statement (N);
+      Analyze_Return_Statement (N);
    end Analyze_Extended_Return_Statement;
 
    ----------------------------
@@ -430,7 +440,7 @@ package body Sem_Ch6 is
       Stm_Entity : constant Entity_Id   := Return_Statement_Entity (N);
       Scope_Id   : constant Entity_Id   := Return_Applies_To (Stm_Entity);
 
-      R_Type : constant Entity_Id   := Etype (Scope_Id);
+      R_Type : constant Entity_Id := Etype (Scope_Id);
       --  Function result subtype
 
       procedure Check_Limited_Return (Expr : Node_Id);
@@ -466,7 +476,7 @@ package body Sem_Ch6 is
             then
                Error_Msg_N
                  ("(Ada 2005) cannot copy object of a limited type " &
-                  "('R'M'-2005 6.5(5.5/2))", Expr);
+                  "(RM-2005 6.5(5.5/2))", Expr);
                if Is_Inherently_Limited_Type (R_Type) then
                   Error_Msg_N
                     ("\return by reference not permitted in Ada 2005", Expr);
@@ -482,11 +492,11 @@ package body Sem_Ch6 is
                if Is_Inherently_Limited_Type (R_Type) then
                   Error_Msg_N
                     ("return by reference not permitted in Ada 2005 " &
-                     "('R'M'-2005 6.5(5.5/2))?", Expr);
+                     "(RM-2005 6.5(5.5/2))?", Expr);
                else
                   Error_Msg_N
                     ("cannot copy object of a limited type in Ada 2005 " &
-                     "('R'M'-2005 6.5(5.5/2))?", Expr);
+                     "(RM-2005 6.5(5.5/2))?", Expr);
                end if;
 
             --  Ada 95 mode, compatibility warnings disabled
@@ -585,7 +595,8 @@ package body Sem_Ch6 is
          --  needed. ???)
 
          elsif Is_Class_Wide_Type (R_Type)
-           and then R_Type = Etype (Object_Definition (Obj_Decl))
+           and then
+             R_Type = Etype (Object_Definition (Original_Node (Obj_Decl)))
          then
             null;
 
@@ -606,7 +617,7 @@ package body Sem_Ch6 is
    begin
       Set_Return_Present (Scope_Id);
 
-      if Nkind (N) = N_Return_Statement then
+      if Nkind (N) = N_Simple_Return_Statement then
          Expr := Expression (N);
          Analyze_And_Resolve (Expr, R_Type);
          Check_Limited_Return (Expr);
@@ -649,13 +660,21 @@ package body Sem_Ch6 is
          end;
       end if;
 
+      --  Case of Expr present (Etype check defends against previous errors)
+
       if Present (Expr)
-        and then Present (Etype (Expr)) --  Could be False in case of errors.
+        and then Present (Etype (Expr))
       then
-         --  Ada 2005 (AI-318-02): When the result type is an anonymous
-         --  access type, apply an implicit conversion of the expression
-         --  to that type to force appropriate static and run-time
-         --  accessibility checks.
+         --  Apply constraint check. Note that this is done before the implicit
+         --  conversion of the expression done for anonymous access types to
+         --  ensure correct generation of the null-excluding check asssociated
+         --  with null-excluding expressions found in return statements.
+
+         Apply_Constraint_Check (Expr, R_Type);
+
+         --  Ada 2005 (AI-318-02): When the result type is an anonymous access
+         --  type, apply an implicit conversion of the expression to that type
+         --  to force appropriate static and run-time accessibility checks.
 
          if Ada_Version >= Ada_05
            and then Ekind (R_Type) = E_Anonymous_Access_Type
@@ -672,8 +691,6 @@ package body Sem_Ch6 is
               ("dynamically tagged expression not allowed!", Expr);
          end if;
 
-         Apply_Constraint_Check (Expr, R_Type);
-
          --  ??? A real run-time accessibility check is needed in cases
          --  involving dereferences of access parameters. For now we just
          --  check the static cases.
@@ -694,6 +711,17 @@ package body Sem_Ch6 is
               ("\& will be raised at run time?",
                N, Standard_Program_Error);
          end if;
+
+         if Known_Null (Expr)
+           and then Nkind (Parent (Scope_Id)) = N_Function_Specification
+           and then Null_Exclusion_Present (Parent (Scope_Id))
+         then
+            Apply_Compile_Time_Constraint_Error
+              (N      => Expr,
+               Msg    => "(Ada 2005) null not allowed for "
+                         & "null-excluding return?",
+               Reason => CE_Null_Not_Allowed);
+         end if;
       end if;
    end Analyze_Function_Return;
 
@@ -864,7 +892,10 @@ package body Sem_Ch6 is
 
       Set_Ekind (Gen_Id, Kind);
       Generate_Reference (Gen_Id, Body_Id, 'b', Set_Ref => False);
-      Style.Check_Identifier (Body_Id, Gen_Id);
+
+      if Style_Check then
+         Style.Check_Identifier (Body_Id, Gen_Id);
+      end if;
       End_Generic;
    end Analyze_Generic_Subprogram_Body;
 
@@ -1127,142 +1158,18 @@ package body Sem_Ch6 is
       end if;
    end Analyze_Procedure_Call;
 
-   ------------------------------
-   -- Analyze_Return_Statement --
-   ------------------------------
-
-   procedure Analyze_Return_Statement (N : Node_Id) is
-      Loc      : constant Source_Ptr := Sloc (N);
-      Expr     : Node_Id;
-      Scope_Id : Entity_Id;
-      Kind     : Entity_Kind;
-      R_Type   : Entity_Id;
-
-      Stm_Entity : constant Entity_Id   :=
-                     New_Internal_Entity
-                       (E_Return_Statement, Current_Scope, Loc, 'R');
+   -------------------------------------
+   -- Analyze_Simple_Return_Statement --
+   -------------------------------------
 
+   procedure Analyze_Simple_Return_Statement (N : Node_Id) is
    begin
-      if Enable_New_Return_Processing then --  ???Temporary hack.
-         Analyze_A_Return_Statement (N);
-         return;
-      end if;
-
-      --  Find subprogram or accept statement enclosing the return statement
-
-      Scope_Id := Empty;
-      for J in reverse 0 .. Scope_Stack.Last loop
-         Scope_Id := Scope_Stack.Table (J).Entity;
-         exit when Ekind (Scope_Id) /= E_Block and then
-                   Ekind (Scope_Id) /= E_Loop;
-      end loop;
-
-      pragma Assert (Present (Scope_Id));
-
-      Set_Return_Statement_Entity (N, Stm_Entity);
-      Set_Return_Applies_To (Stm_Entity, Scope_Id);
-
-      Kind := Ekind (Scope_Id);
-      Expr := Expression (N);
-
-      if Kind /= E_Function
-        and then Kind /= E_Generic_Function
-        and then Kind /= E_Procedure
-        and then Kind /= E_Generic_Procedure
-        and then Kind /= E_Entry
-        and then Kind /= E_Entry_Family
-      then
-         Error_Msg_N ("illegal context for return statement", N);
-
-      elsif Present (Expr) then
-         if Kind = E_Function or else Kind = E_Generic_Function then
-            Set_Return_Present (Scope_Id);
-            R_Type := Etype (Scope_Id);
-            Analyze_And_Resolve (Expr, R_Type);
-
-            --  Ada 2005 (AI-318-02): When the result type is an anonymous
-            --  access type, apply an implicit conversion of the expression
-            --  to that type to force appropriate static and run-time
-            --  accessibility checks.
-
-            if Ada_Version >= Ada_05
-              and then Ekind (R_Type) = E_Anonymous_Access_Type
-            then
-               Rewrite (Expr, Convert_To (R_Type, Relocate_Node (Expr)));
-               Analyze_And_Resolve (Expr, R_Type);
-            end if;
-
-            if (Is_Class_Wide_Type (Etype (Expr))
-                 or else Is_Dynamically_Tagged (Expr))
-              and then not Is_Class_Wide_Type (R_Type)
-            then
-               Error_Msg_N
-                 ("dynamically tagged expression not allowed!", Expr);
-            end if;
-
-            Apply_Constraint_Check (Expr, R_Type);
-
-            --  Ada 2005 (AI-318-02): Return-by-reference types have been
-            --  removed and replaced by anonymous access results. This is
-            --  an incompatibility with Ada 95. Not clear whether this
-            --  should be enforced yet or perhaps controllable with a
-            --  special switch. ???
-
-            --  if Ada_Version >= Ada_05
-            --    and then Is_Limited_Type (R_Type)
-            --    and then Nkind (Expr) /= N_Aggregate
-            --    and then Nkind (Expr) /= N_Extension_Aggregate
-            --    and then Nkind (Expr) /= N_Function_Call
-            --  then
-            --     Error_Msg_N
-            --       ("(Ada 2005) illegal operand for limited return", N);
-            --  end if;
-
-            --  ??? A real run-time accessibility check is needed in cases
-            --  involving dereferences of access parameters. For now we just
-            --  check the static cases.
-
-            if Is_Inherently_Limited_Type (Etype (Scope_Id))
-              and then Object_Access_Level (Expr)
-                > Subprogram_Access_Level (Scope_Id)
-            then
-               Rewrite (N,
-                 Make_Raise_Program_Error (Loc,
-                   Reason => PE_Accessibility_Check_Failed));
-               Analyze (N);
-
-               Error_Msg_N
-                 ("cannot return a local value by reference?", N);
-               Error_Msg_NE
-                 ("\& will be raised at run time?",
-                  N, Standard_Program_Error);
-            end if;
-
-         elsif Kind = E_Procedure or else Kind = E_Generic_Procedure then
-            Error_Msg_N ("procedure cannot return value (use function)", N);
-
-         else
-            Error_Msg_N ("accept statement cannot return value", N);
-         end if;
-
-      --  No expression present
-
-      else
-         if Kind = E_Function or Kind = E_Generic_Function then
-            Error_Msg_N ("missing expression in return from function", N);
-         end if;
-
-         if (Ekind (Scope_Id) = E_Procedure
-              or else Ekind (Scope_Id) = E_Generic_Procedure)
-           and then No_Return (Scope_Id)
-         then
-            Error_Msg_N
-              ("RETURN statement not allowed (No_Return)", N);
-         end if;
+      if Present (Expression (N)) then
+         Mark_Coextensions (N, Expression (N));
       end if;
 
-      Check_Unreachable_Code (N);
-   end Analyze_Return_Statement;
+      Analyze_Return_Statement (N);
+   end Analyze_Simple_Return_Statement;
 
    -------------------------
    -- Analyze_Return_Type --
@@ -1528,12 +1435,20 @@ package body Sem_Ch6 is
             Error_Msg_NE
               ("subprogram& is not overriding", Body_Spec, Spec_Id);
 
-         elsif Must_Not_Override (Body_Spec)
-              and then Is_Overriding_Operation (Spec_Id)
-         then
-            Error_Msg_NE
-              ("subprogram& overrides inherited operation",
-                 Body_Spec, Spec_Id);
+         elsif Must_Not_Override (Body_Spec) then
+            if Is_Overriding_Operation (Spec_Id) then
+               Error_Msg_NE
+                 ("subprogram& overrides inherited operation",
+                    Body_Spec, Spec_Id);
+
+            --  If this is not a primitive operation the overriding indicator
+            --  is altogether illegal.
+
+            elsif not Is_Primitive (Spec_Id) then
+               Error_Msg_N ("overriding indicator only allowed " &
+                "if subprogram is primitive",
+                Body_Spec);
+            end if;
          end if;
       end Verify_Overriding_Indicator;
 
@@ -1731,6 +1646,28 @@ package body Sem_Ch6 is
       elsif Present (Spec_Id) then
          Spec_Decl := Unit_Declaration_Node (Spec_Id);
          Verify_Overriding_Indicator;
+
+         --  In general, the spec will be frozen when we start analyzing the
+         --  body. However, for internally generated operations, such as
+         --  wrapper functions for inherited operations with controlling
+         --  results, the spec may not have been frozen by the time we
+         --  expand the freeze actions that include the bodies. In particular,
+         --  extra formals for accessibility or for return-in-place may need
+         --  to be generated. Freeze nodes, if any, are inserted before the
+         --  current body.
+
+         if not Is_Frozen (Spec_Id)
+           and then Expander_Active
+         then
+            --  Force the generation of its freezing node to ensure proper
+            --  management of access types in the backend.
+
+            --  This is definitely needed for some cases, but it is not clear
+            --  why, to be investigated further???
+
+            Set_Has_Delayed_Freeze (Spec_Id);
+            Insert_Actions (N, Freeze_Entity (Spec_Id, Loc));
+         end if;
       end if;
 
       --  Place subprogram on scope stack, and make formals visible. If there
@@ -1808,22 +1745,41 @@ package body Sem_Ch6 is
          if Nkind (N) /= N_Subprogram_Body_Stub then
             Set_Corresponding_Spec (N, Spec_Id);
 
-            --  Ada 2005 (AI-345): Restore the correct Etype: here we undo the
-            --  work done by Analyze_Subprogram_Specification to allow the
-            --  overriding of task, protected and interface primitives.
+            --  Ada 2005 (AI-345): If the operation is a primitive operation
+            --  of a concurrent type, the type of the first parameter has been
+            --  replaced with the corresponding record, which is the proper
+            --  run-time structure to use. However, within the body there may
+            --  be uses of the formals that depend on primitive operations
+            --  of the type (in particular calls in prefixed form) for which
+            --  we need the original concurrent type. The operation may have
+            --  several controlling formals, so the replacement must be done
+            --  for all of them.
 
             if Comes_From_Source (Spec_Id)
               and then Present (First_Entity (Spec_Id))
               and then Ekind (Etype (First_Entity (Spec_Id))) = E_Record_Type
               and then Is_Tagged_Type (Etype (First_Entity (Spec_Id)))
-              and then Present (Abstract_Interfaces
-                                (Etype (First_Entity (Spec_Id))))
-              and then Present (Corresponding_Concurrent_Type
-                                (Etype (First_Entity (Spec_Id))))
+              and then
+                Present (Abstract_Interfaces (Etype (First_Entity (Spec_Id))))
+              and then
+                Present
+                 (Corresponding_Concurrent_Type
+                   (Etype (First_Entity (Spec_Id))))
             then
-               Set_Etype (First_Entity (Spec_Id),
-                 Corresponding_Concurrent_Type
-                   (Etype (First_Entity (Spec_Id))));
+               declare
+                  Typ  : constant Entity_Id := Etype (First_Entity (Spec_Id));
+                  Form : Entity_Id;
+
+               begin
+                  Form := First_Formal (Spec_Id);
+                  while Present (Form) loop
+                     if Etype (Form) = Typ then
+                        Set_Etype (Form, Corresponding_Concurrent_Type (Typ));
+                     end if;
+
+                     Next_Formal (Form);
+                  end loop;
+               end;
             end if;
 
             --  Now make the formals visible, and place subprogram
@@ -2677,7 +2633,7 @@ package body Sem_Ch6 is
 
          function Check_Return (N : Node_Id) return Traverse_Result is
          begin
-            if Nkind (N) = N_Return_Statement then
+            if Nkind (N) = N_Simple_Return_Statement then
                if Present (Expression (N))
                  and then Is_Entity_Name (Expression (N))
                then
@@ -3038,7 +2994,7 @@ package body Sem_Ch6 is
         and then New_Type /= Standard_Void_Type
       then
          if not Conforming_Types (Old_Type, New_Type, Ctype, Get_Inst) then
-            Conformance_Error ("return type does not match!", New_Id);
+            Conformance_Error ("\return type does not match!", New_Id);
             return;
          end if;
 
@@ -3053,7 +3009,7 @@ package body Sem_Ch6 is
               or else Is_Access_Constant (Etype (Old_Type))
                         /= Is_Access_Constant (Etype (New_Type)))
          then
-            Conformance_Error ("return type does not match!", New_Id);
+            Conformance_Error ("\return type does not match!", New_Id);
             return;
          end if;
 
@@ -3062,7 +3018,7 @@ package body Sem_Ch6 is
       elsif Old_Type /= Standard_Void_Type
         or else New_Type /= Standard_Void_Type
       then
-         Conformance_Error ("functions can only match functions!", New_Id);
+         Conformance_Error ("\functions can only match functions!", New_Id);
          return;
       end if;
 
@@ -3086,10 +3042,10 @@ package body Sem_Ch6 is
                Error_Msg_Name_2 :=
                  Name_Ada + Convention_Id'Pos (Convention (New_Id));
 
-               Conformance_Error ("prior declaration for% has convention %!");
+               Conformance_Error ("\prior declaration for% has convention %!");
 
             else
-               Conformance_Error ("calling conventions do not match!");
+               Conformance_Error ("\calling conventions do not match!");
             end if;
 
             return;
@@ -3097,7 +3053,7 @@ package body Sem_Ch6 is
          elsif Is_Formal_Subprogram (Old_Id)
            or else Is_Formal_Subprogram (New_Id)
          then
-            Conformance_Error ("formal subprograms not allowed!");
+            Conformance_Error ("\formal subprograms not allowed!");
             return;
          end if;
       end if;
@@ -3126,7 +3082,7 @@ package body Sem_Ch6 is
             --  this before checking that the types of the formals match.
 
             if Chars (Old_Formal) /= Chars (New_Formal) then
-               Conformance_Error ("name & does not match!", New_Formal);
+               Conformance_Error ("\name & does not match!", New_Formal);
 
                --  Set error posted flag on new formal as well to stop
                --  junk cascaded messages in some cases.
@@ -3159,10 +3115,10 @@ package body Sem_Ch6 is
          Access_Types_Match := Ada_Version >= Ada_05
 
             --  Ensure that this rule is only applied when New_Id is a
-            --  renaming of Old_Id
+            --  renaming of Old_Id.
 
-           and then Nkind (Parent (Parent (New_Id)))
-                      = N_Subprogram_Renaming_Declaration
+           and then Nkind (Parent (Parent (New_Id))) =
+                      N_Subprogram_Renaming_Declaration
            and then Nkind (Name (Parent (Parent (New_Id)))) in N_Has_Entity
            and then Present (Entity (Name (Parent (Parent (New_Id)))))
            and then Entity (Name (Parent (Parent (New_Id)))) = Old_Id
@@ -3171,6 +3127,30 @@ package body Sem_Ch6 is
 
            and then Is_Access_Type (Old_Formal_Base)
            and then Is_Access_Type (New_Formal_Base)
+
+            --  The type kinds must match. The only exception occurs with
+            --  multiple generics of the form:
+
+            --   generic                    generic
+            --     type F is private;         type A is private;
+            --     type F_Ptr is access F;    type A_Ptr is access A;
+            --     with proc F_P (X : F_Ptr); with proc A_P (X : A_Ptr);
+            --   package F_Pack is ...      package A_Pack is
+            --                                package F_Inst is
+            --                                  new F_Pack (A, A_Ptr, A_P);
+
+            --  When checking for conformance between the parameters of A_P
+            --  and F_P, the type kinds of F_Ptr and A_Ptr will not match
+            --  because the compiler has transformed A_Ptr into a subtype of
+            --  F_Ptr. We catch this case in the code below.
+
+           and then (Ekind (Old_Formal_Base) = Ekind (New_Formal_Base)
+                  or else
+                    (Is_Generic_Type (Old_Formal_Base)
+                       and then Is_Generic_Type (New_Formal_Base)
+                       and then Is_Internal (New_Formal_Base)
+                       and then Etype (Etype (New_Formal_Base)) =
+                                  Old_Formal_Base))
            and then Directly_Designated_Type (Old_Formal_Base) =
                       Directly_Designated_Type (New_Formal_Base)
            and then ((Is_Itype (Old_Formal_Base)
@@ -3193,28 +3173,39 @@ package body Sem_Ch6 is
                       Get_Inst => Get_Inst)
                and then not Access_Types_Match
             then
-               Conformance_Error ("type of & does not match!", New_Formal);
+               Conformance_Error ("\type of & does not match!", New_Formal);
                return;
             end if;
 
          elsif not Conforming_Types
-                     (T1       => Etype (Old_Formal),
-                      T2       => Etype (New_Formal),
+                     (T1       => Old_Formal_Base,
+                      T2       => New_Formal_Base,
                       Ctype    => Ctype,
                       Get_Inst => Get_Inst)
            and then not Access_Types_Match
          then
-            Conformance_Error ("type of & does not match!", New_Formal);
+            Conformance_Error ("\type of & does not match!", New_Formal);
             return;
          end if;
 
          --  For mode conformance, mode must match
 
-         if Ctype >= Mode_Conformant
-           and then Parameter_Mode (Old_Formal) /= Parameter_Mode (New_Formal)
-         then
-            Conformance_Error ("mode of & does not match!", New_Formal);
-            return;
+         if Ctype >= Mode_Conformant then
+            if Parameter_Mode (Old_Formal) /= Parameter_Mode (New_Formal) then
+               Conformance_Error ("\mode of & does not match!", New_Formal);
+               return;
+
+            --  Part of mode conformance for access types is having the same
+            --  constant modifier.
+
+            elsif Access_Types_Match
+              and then Is_Access_Constant (Old_Formal_Base) /=
+                       Is_Access_Constant (New_Formal_Base)
+            then
+               Conformance_Error
+                 ("\constant modifier does not match!", New_Formal);
+               return;
+            end if;
          end if;
 
          if Ctype >= Subtype_Conformant then
@@ -3246,7 +3237,7 @@ package body Sem_Ch6 is
                     and then TSS_Name /= TSS_Stream_Output
                   then
                      Conformance_Error
-                       ("type of & does not match!", New_Formal);
+                       ("\type of & does not match!", New_Formal);
                      return;
                   end if;
                end;
@@ -3289,7 +3280,7 @@ package body Sem_Ch6 is
                                      Default_Value (New_Formal))
                      then
                         Conformance_Error
-                          ("default expression for & does not match!",
+                          ("\default expression for & does not match!",
                            New_Formal);
                         return;
                      end if;
@@ -3320,7 +3311,7 @@ package body Sem_Ch6 is
                  and then Ctype = Fully_Conformant
                then
                   Conformance_Error
-                    ("(Ada 83) IN must appear in both declarations",
+                    ("\(Ada 83) IN must appear in both declarations",
                      New_Formal);
                   return;
                end if;
@@ -3338,7 +3329,7 @@ package body Sem_Ch6 is
                  or else Prev_Ids (Old_Param) /= Prev_Ids (New_Param)
                then
                   Conformance_Error
-                    ("grouping of & does not match!", New_Formal);
+                    ("\grouping of & does not match!", New_Formal);
                   return;
                end if;
             end;
@@ -3353,11 +3344,11 @@ package body Sem_Ch6 is
       end loop;
 
       if Present (Old_Formal) then
-         Conformance_Error ("too few parameters!");
+         Conformance_Error ("\too few parameters!");
          return;
 
       elsif Present (New_Formal) then
-         Conformance_Error ("too many parameters!", New_Formal);
+         Conformance_Error ("\too many parameters!", New_Formal);
          return;
       end if;
    end Check_Conformance;
@@ -3769,7 +3760,8 @@ package body Sem_Ch6 is
 
    procedure Check_Overriding_Indicator
      (Subp            : Entity_Id;
-      Overridden_Subp : Entity_Id := Empty)
+      Overridden_Subp : Entity_Id;
+      Is_Primitive    : Boolean)
    is
       Decl : Node_Id;
       Spec : Node_Id;
@@ -3807,47 +3799,59 @@ package body Sem_Ch6 is
             Error_Msg_Sloc := Sloc (Overridden_Subp);
 
             if Ekind (Subp) = E_Entry then
-               Error_Msg_NE ("entry & overrides inherited operation #",
-                             Spec, Subp);
-
+               Error_Msg_NE
+                 ("entry & overrides inherited operation #", Spec, Subp);
             else
-               Error_Msg_NE ("subprogram & overrides inherited operation #",
-                             Spec, Subp);
+               Error_Msg_NE
+                 ("subprogram & overrides inherited operation #", Spec, Subp);
             end if;
          end if;
 
       --  If Subp is an operator, it may override a predefined operation.
       --  In that case overridden_subp is empty because of our implicit
-      --  representation for predefined operators. We have to check whether
-      --  the signature of Subp matches that of a predefined operator.
-      --  Note that first argument provides the name of the operator, and
-      --  the second argument the signature that may match that of a standard
-      --  operation.
+      --  representation for predefined operators. We have to check whether the
+      --  signature of Subp matches that of a predefined operator. Note that
+      --  first argument provides the name of the operator, and the second
+      --  argument the signature that may match that of a standard operation.
 
       elsif Nkind (Subp) = N_Defining_Operator_Symbol
         and then  Must_Not_Override (Spec)
       then
          if Operator_Matches_Spec (Subp, Subp) then
             Error_Msg_NE
-              ("subprogram & overrides predefined operation ",
+              ("subprogram & overrides predefined operator ",
                  Spec, Subp);
          end if;
 
-      else
-         if Must_Override (Spec) then
-            if Ekind (Subp) = E_Entry then
-               Error_Msg_NE ("entry & is not overriding", Spec, Subp);
-
-            elsif Nkind (Subp) = N_Defining_Operator_Symbol then
-               if not Operator_Matches_Spec (Subp, Subp) then
-                  Error_Msg_NE
-                    ("subprogram & is not overriding", Spec, Subp);
-               end if;
+      elsif Must_Override (Spec) then
+         if Ekind (Subp) = E_Entry then
+            Error_Msg_NE ("entry & is not overriding", Spec, Subp);
 
-            else
-               Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
+         elsif Nkind (Subp) = N_Defining_Operator_Symbol then
+            if not Operator_Matches_Spec (Subp, Subp) then
+               Error_Msg_NE
+                 ("subprogram & is not overriding", Spec, Subp);
             end if;
+
+         else
+            Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
          end if;
+
+      --  If the operation is marked "not overriding" and it's not primitive
+      --  then an error is issued, unless this is an operation of a task or
+      --  protected type (RM05-8.3.1(3/2-4/2)). Error cases where "overriding"
+      --  has been specified have already been checked above.
+
+      elsif Must_Not_Override (Spec)
+        and then not Is_Primitive
+        and then Ekind (Subp) /= E_Entry
+        and then Ekind (Scope (Subp)) /= E_Protected_Type
+      then
+         Error_Msg_N
+           ("overriding indicator only allowed if subprogram is primitive",
+            Subp);
+
+         return;
       end if;
    end Check_Overriding_Indicator;
 
@@ -4177,10 +4181,10 @@ package body Sem_Ch6 is
          if Mode = 'F' then
             if not Raise_Exception_Call then
                Error_Msg_N
-                 ("?RETURN statement missing following this statement",
+                 ("?RETURN statement missing following this statement!",
                   Last_Stm);
                Error_Msg_N
-                 ("\?Program_Error may be raised at run time",
+                 ("\?Program_Error may be raised at run time!",
                   Last_Stm);
             end if;
 
@@ -4375,6 +4379,12 @@ package body Sem_Ch6 is
       --  spurious ambiguities in an instantiation that may arise if two
       --  distinct generic types are instantiated with the same actual.
 
+      function Find_Designated_Type (T : Entity_Id) return Entity_Id;
+      --  An access parameter can designate an incomplete type. If the
+      --  incomplete type is the limited view of a type from a limited_
+      --  with_clause, check whether the non-limited view is available. If
+      --  it is a (non-limited) incomplete type, get the full view.
+
       function Matches_Limited_With_View (T1, T2 : Entity_Id) return Boolean;
       --  Returns True if and only if either T1 denotes a limited view of T2
       --  or T2 denotes a limited view of T1. This can arise when the limited
@@ -4407,6 +4417,34 @@ package body Sem_Ch6 is
          end if;
       end Base_Types_Match;
 
+      --------------------------
+      -- Find_Designated_Type --
+      --------------------------
+
+      function Find_Designated_Type (T : Entity_Id) return Entity_Id is
+         Desig : Entity_Id;
+
+      begin
+         Desig := Directly_Designated_Type (T);
+
+         if Ekind (Desig) = E_Incomplete_Type then
+
+            --  If regular incomplete type, get full view if available
+
+            if Present (Full_View (Desig)) then
+               Desig := Full_View (Desig);
+
+            --  If limited view of a type, get non-limited view if available,
+            --  and check again for a regular incomplete type.
+
+            elsif Present (Non_Limited_View (Desig)) then
+               Desig := Get_Full_View (Non_Limited_View (Desig));
+            end if;
+         end if;
+
+         return Desig;
+      end Find_Designated_Type;
+
       -------------------------------
       -- Matches_Limited_With_View --
       -------------------------------
@@ -4490,10 +4528,13 @@ package body Sem_Ch6 is
                Ekind (Type_1) = E_Anonymous_Access_Protected_Subprogram_Type);
 
       --  Test anonymous access type case. For this case, static subtype
-      --  matching is required for mode conformance (RM 6.3.1(15))
+      --  matching is required for mode conformance (RM 6.3.1(15)). We check
+      --  the base types because we may have built internal subtype entities
+      --  to handle null-excluding types (see Process_Formals).
 
-      if (Ekind (Type_1) = E_Anonymous_Access_Type
-            and then Ekind (Type_2) = E_Anonymous_Access_Type)
+      if (Ekind (Base_Type (Type_1)) = E_Anonymous_Access_Type
+            and then
+          Ekind (Base_Type (Type_2)) = E_Anonymous_Access_Type)
         or else Are_Anonymous_Access_To_Subprogram_Types -- Ada 2005 (AI-254)
       then
          declare
@@ -4501,33 +4542,22 @@ package body Sem_Ch6 is
             Desig_2 : Entity_Id;
 
          begin
-            Desig_1 := Directly_Designated_Type (Type_1);
-
-            --  An access parameter can designate an incomplete type
-            --  If the incomplete type is the limited view of a type
-            --  from a limited_with_clause, check whether the non-limited
-            --  view is available.
-
-            if Ekind (Desig_1) = E_Incomplete_Type then
-               if Present (Full_View (Desig_1)) then
-                  Desig_1 := Full_View (Desig_1);
+            --  In Ada2005, access constant indicators must match for
+            --  subtype conformance.
 
-               elsif Present (Non_Limited_View (Desig_1)) then
-                  Desig_1 := Non_Limited_View (Desig_1);
-               end if;
+            if Ada_Version >= Ada_05
+              and then Ctype >= Subtype_Conformant
+              and then
+                Is_Access_Constant (Type_1) /= Is_Access_Constant (Type_2)
+            then
+               return False;
             end if;
 
-            Desig_2 := Directly_Designated_Type (Type_2);
+            Desig_1 := Find_Designated_Type (Type_1);
 
-            if Ekind (Desig_2) = E_Incomplete_Type then
-               if Present (Full_View (Desig_2)) then
-                  Desig_2 := Full_View (Desig_2);
-               elsif Present (Non_Limited_View (Desig_2)) then
-                  Desig_2 := Non_Limited_View (Desig_2);
-               end if;
-            end if;
+            Desig_2 := Find_Designated_Type (Type_2);
 
-            --  The context is an instance association for a formal
+            --  If the context is an instance association for a formal
             --  access-to-subprogram type; formal access parameter designated
             --  types require mapping because they may denote other formal
             --  parameters of the generic unit.
@@ -4699,7 +4729,6 @@ package body Sem_Ch6 is
       end if;
 
       Formal := First_Formal (E);
-
       while Present (Formal) loop
 
          --  Create extra formal for supporting the attribute 'Constrained.
@@ -4733,9 +4762,7 @@ package body Sem_Ch6 is
               and then not Is_Indefinite_Subtype (Formal_Type)
             then
                Set_Extra_Constrained
-                 (Formal,
-                  Add_Extra_Formal
-                    (Formal, Standard_Boolean, Scope (Formal), "F"));
+                 (Formal, Add_Extra_Formal (Formal, Standard_Boolean, E, "F"));
             end if;
          end if;
 
@@ -4745,6 +4772,8 @@ package body Sem_Ch6 is
          --  case can occur when Expand_Dispatching_Call creates a subprogram
          --  type and substitutes the types of access-to-class-wide actuals
          --  for the anonymous access-to-specific-type of controlling formals.
+         --  Base_Type is applied because in cases where there is a null
+         --  exclusion the formal may have an access subtype.
 
          --  This is suppressed if we specifically suppress accessibility
          --  checks at the package level for either the subprogram, or the
@@ -4754,9 +4783,9 @@ package body Sem_Ch6 is
          --  different suppression setting. The explicit checks at the
          --  package level are safe from this point of view.
 
-         if (Ekind (Etype (Formal)) = E_Anonymous_Access_Type
+         if (Ekind (Base_Type (Etype (Formal))) = E_Anonymous_Access_Type
               or else (Is_Controlling_Formal (Formal)
-                        and then Is_Access_Type (Etype (Formal))))
+                        and then Is_Access_Type (Base_Type (Etype (Formal)))))
            and then not
              (Explicit_Suppress (E, Accessibility_Check)
                or else
@@ -4773,9 +4802,7 @@ package body Sem_Ch6 is
               and then Nkind (Parent (Parent (Parent (E)))) /= N_Protected_Body
             then
                Set_Extra_Accessibility
-                 (Formal,
-                  Add_Extra_Formal
-                    (Formal, Standard_Natural, Scope (Formal), "F"));
+                 (Formal, Add_Extra_Formal (Formal, Standard_Natural, E, "F"));
             end if;
          end if;
 
@@ -4984,7 +5011,6 @@ package body Sem_Ch6 is
 
    begin
       E := Current_Entity (Designator);
-
       while Present (E) loop
 
          --  We are looking for a matching spec. It must have the same scope,
@@ -5059,10 +5085,9 @@ package body Sem_Ch6 is
               and then
                 Nkind (Unit_Declaration_Node (Designator)) = N_Subprogram_Body
               and then
-                Nkind (Parent (Unit_Declaration_Node (Designator)))
-                  = N_Compilation_Unit
+                Nkind (Parent (Unit_Declaration_Node (Designator))) =
+                                                             N_Compilation_Unit
             then
-
                --  Child units cannot be overloaded, so a conformance mismatch
                --  between body and a previous spec is an error.
 
@@ -5482,6 +5507,10 @@ package body Sem_Ch6 is
       function Conforming_Ranges (R1, R2 : Node_Id) return Boolean;
       --  Check both bounds
 
+      -----------------------
+      -- Conforming_Bounds --
+      -----------------------
+
       function Conforming_Bounds (B1, B2 : Node_Id) return Boolean is
       begin
          if Is_Entity_Name (B1)
@@ -5495,6 +5524,10 @@ package body Sem_Ch6 is
          end if;
       end Conforming_Bounds;
 
+      -----------------------
+      -- Conforming_Ranges --
+      -----------------------
+
       function Conforming_Ranges (R1, R2 : Node_Id) return Boolean is
       begin
          return
@@ -5566,9 +5599,8 @@ package body Sem_Ch6 is
       G_Typ  : Entity_Id := Empty;
 
       function Get_Generic_Parent_Type (F_Typ : Entity_Id) return Entity_Id;
-      --  If F_Type is a derived type associated with a generic actual
-      --  subtype, then return its Generic_Parent_Type attribute, else return
-      --  Empty.
+      --  If F_Type is a derived type associated with a generic actual subtype,
+      --  then return its Generic_Parent_Type attribute, else return Empty.
 
       function Types_Correspond
         (P_Type : Entity_Id;
@@ -5793,9 +5825,9 @@ package body Sem_Ch6 is
                Make_Defining_Identifier (Sloc (FF),
                  Chars => Chars (FF));
 
-         B  : constant Entity_Id :=
-                Make_Defining_Identifier (Sloc (NF),
-                  Chars => Chars (NF));
+         B : constant Entity_Id :=
+               Make_Defining_Identifier (Sloc (NF),
+                 Chars => Chars (NF));
 
       begin
          Op_Name := Make_Defining_Operator_Symbol (Loc, Name_Op_Ne);
@@ -5862,7 +5894,6 @@ package body Sem_Ch6 is
    begin
       F := First_Formal (Fun);
       B := True;
-
       while Present (F) loop
          if No (Default_Value (F)) then
             B := False;
@@ -5898,12 +5929,23 @@ package body Sem_Ch6 is
       --  Set if the current scope has an operation that is type-conformant
       --  with S, and becomes hidden by S.
 
+      Is_Primitive_Subp : Boolean;
+      --  Set to True if the new subprogram is primitive
+
       E : Entity_Id;
       --  Entity that S overrides
 
       Prev_Vis : Entity_Id := Empty;
       --  Predecessor of E in Homonym chain
 
+      procedure Check_For_Primitive_Subprogram
+        (Is_Primitive  : out Boolean;
+         Is_Overriding : Boolean := False);
+      --  If the subprogram being analyzed is a primitive operation of the type
+      --  of a formal or result, set the Has_Primitive_Operations flag on the
+      --  type, and set Is_Primitive to True (otherwise set to False). Set the
+      --  corresponding flag on the entity itself for later use.
+
       procedure Check_Synchronized_Overriding
         (Def_Id          : Entity_Id;
          First_Hom       : Entity_Id;
@@ -5921,130 +5963,14 @@ package body Sem_Ch6 is
       --  set when freezing entities, so we must examine the place of the
       --  declaration in the tree, and recognize wrapper packages as well.
 
-      procedure Maybe_Primitive_Operation (Is_Overriding : Boolean := False);
-      --  If the subprogram being analyzed is a primitive operation of
-      --  the type of one of its formals, set the corresponding flag.
+      ------------------------------------
+      -- Check_For_Primitive_Subprogram --
+      ------------------------------------
 
-      -----------------------------------
-      -- Check_Synchronized_Overriding --
-      -----------------------------------
-
-      procedure Check_Synchronized_Overriding
-        (Def_Id          : Entity_Id;
-         First_Hom       : Entity_Id;
-         Overridden_Subp : out Entity_Id)
+      procedure Check_For_Primitive_Subprogram
+        (Is_Primitive  : out Boolean;
+         Is_Overriding : Boolean := False)
       is
-         Formal_Typ  : Entity_Id;
-         Ifaces_List : Elist_Id;
-         In_Scope    : Boolean;
-         Typ         : Entity_Id;
-
-      begin
-         Overridden_Subp := Empty;
-
-         --  Def_Id must be an entry or a subprogram
-
-         if Ekind (Def_Id) /= E_Entry
-           and then Ekind (Def_Id) /= E_Function
-           and then Ekind (Def_Id) /= E_Procedure
-         then
-            return;
-         end if;
-
-         --  Search for the concurrent declaration since it contains the list
-         --  of all implemented interfaces. In this case, the subprogram is
-         --  declared within the scope of a protected or a task type.
-
-         if Present (Scope (Def_Id))
-           and then Is_Concurrent_Type (Scope (Def_Id))
-           and then not Is_Generic_Actual_Type (Scope (Def_Id))
-         then
-            Typ := Scope (Def_Id);
-            In_Scope := True;
-
-         --  The subprogram may be a primitive of a concurrent type
-
-         elsif Present (First_Formal (Def_Id)) then
-            Formal_Typ := Etype (First_Formal (Def_Id));
-
-            if Is_Concurrent_Type (Formal_Typ)
-              and then not Is_Generic_Actual_Type (Formal_Typ)
-            then
-               Typ := Formal_Typ;
-               In_Scope := False;
-
-            --  This case occurs when the concurrent type is declared within
-            --  a generic unit. As a result the corresponding record has been
-            --  built and used as the type of the first formal, we just have
-            --  to retrieve the corresponding concurrent type.
-
-            elsif Is_Concurrent_Record_Type (Formal_Typ)
-              and then Present (Corresponding_Concurrent_Type (Formal_Typ))
-            then
-               Typ := Corresponding_Concurrent_Type (Formal_Typ);
-               In_Scope := False;
-
-            else
-               return;
-            end if;
-         else
-            return;
-         end if;
-
-         --  Gather all limited, protected and task interfaces that Typ
-         --  implements. There is no overriding to check if is an inherited
-         --  operation in a type derivation on for a generic actual.
-
-         if Nkind (Parent (Typ)) /= N_Full_Type_Declaration
-           and then Nkind (Parent (Def_Id)) /= N_Subtype_Declaration
-           and then Nkind (Parent (Def_Id)) /= N_Task_Type_Declaration
-           and then Nkind (Parent (Def_Id)) /= N_Protected_Type_Declaration
-         then
-            Collect_Abstract_Interfaces (Typ, Ifaces_List);
-
-            if not Is_Empty_Elmt_List (Ifaces_List) then
-               Overridden_Subp :=
-                 Find_Overridden_Synchronized_Primitive
-                   (Def_Id, First_Hom, Ifaces_List, In_Scope);
-            end if;
-         end if;
-      end Check_Synchronized_Overriding;
-
-      ----------------------------
-      -- Is_Private_Declaration --
-      ----------------------------
-
-      function Is_Private_Declaration (E : Entity_Id) return Boolean is
-         Priv_Decls : List_Id;
-         Decl       : constant Node_Id := Unit_Declaration_Node (E);
-
-      begin
-         if Is_Package_Or_Generic_Package (Current_Scope)
-           and then In_Private_Part (Current_Scope)
-         then
-            Priv_Decls :=
-              Private_Declarations (
-                Specification (Unit_Declaration_Node (Current_Scope)));
-
-            return In_Package_Body (Current_Scope)
-              or else
-                (Is_List_Member (Decl)
-                   and then List_Containing (Decl) = Priv_Decls)
-              or else (Nkind (Parent (Decl)) = N_Package_Specification
-                         and then not Is_Compilation_Unit (
-                           Defining_Entity (Parent (Decl)))
-                         and then List_Containing (Parent (Parent (Decl)))
-                           = Priv_Decls);
-         else
-            return False;
-         end if;
-      end Is_Private_Declaration;
-
-      -------------------------------
-      -- Maybe_Primitive_Operation --
-      -------------------------------
-
-      procedure Maybe_Primitive_Operation (Is_Overriding : Boolean := False) is
          Formal : Entity_Id;
          F_Typ  : Entity_Id;
          B_Typ  : Entity_Id;
@@ -6079,7 +6005,7 @@ package body Sem_Ch6 is
                            or else not Is_Abstract_Subprogram (E))
                then
                   Error_Msg_N ("abstract subprograms must be visible "
-                                   & "('R'M 3.9.3(10))!", S);
+                                   & "(RM 3.9.3(10))!", S);
 
                elsif Ekind (S) = E_Function
                  and then Is_Tagged_Type (T)
@@ -6091,7 +6017,7 @@ package body Sem_Ch6 is
                      & " override visible-part function", S);
                   Error_Msg_N
                     ("\move subprogram to the visible part"
-                     & " ('R'M 3.9.3(10))", S);
+                     & " (RM 3.9.3(10))", S);
                end if;
             end if;
          end Check_Private_Overriding;
@@ -6141,29 +6067,42 @@ package body Sem_Ch6 is
             return False;
          end Visible_Part_Type;
 
-      --  Start of processing for Maybe_Primitive_Operation
+      --  Start of processing for Check_For_Primitive_Subprogram
 
       begin
+         Is_Primitive := False;
+
          if not Comes_From_Source (S) then
             null;
 
-         --  If the subprogram is at library level, it is not primitive
-         --  operation.
+         --  If subprogram is at library level, it is not primitive operation
 
          elsif Current_Scope = Standard_Standard then
             null;
 
-         elsif (Ekind (Current_Scope) = E_Package
+         elsif ((Ekind (Current_Scope) = E_Package
+                  or else Ekind (Current_Scope) = E_Generic_Package)
                  and then not In_Package_Body (Current_Scope))
            or else Is_Overriding
          then
             --  For function, check return type
 
             if Ekind (S) = E_Function then
-               B_Typ := Base_Type (Etype (S));
+               if Ekind (Etype (S)) = E_Anonymous_Access_Type then
+                  F_Typ := Designated_Type (Etype (S));
+               else
+                  F_Typ := Etype (S);
+               end if;
+
+               B_Typ := Base_Type (F_Typ);
 
-               if Scope (B_Typ) = Current_Scope then
+               if Scope (B_Typ) = Current_Scope
+                 and then not Is_Class_Wide_Type (B_Typ)
+                 and then not Is_Generic_Type (B_Typ)
+               then
+                  Is_Primitive := True;
                   Set_Has_Primitive_Operations (B_Typ);
+                  Set_Is_Primitive (S);
                   Check_Private_Overriding (B_Typ);
                end if;
             end if;
@@ -6184,7 +6123,12 @@ package body Sem_Ch6 is
                   B_Typ := Base_Type (B_Typ);
                end if;
 
-               if Scope (B_Typ) = Current_Scope then
+               if Scope (B_Typ) = Current_Scope
+                 and then not Is_Class_Wide_Type (B_Typ)
+                 and then not Is_Generic_Type (B_Typ)
+               then
+                  Is_Primitive := True;
+                  Set_Is_Primitive (S);
                   Set_Has_Primitive_Operations (B_Typ);
                   Check_Private_Overriding (B_Typ);
                end if;
@@ -6192,7 +6136,122 @@ package body Sem_Ch6 is
                Next_Formal (Formal);
             end loop;
          end if;
-      end Maybe_Primitive_Operation;
+      end Check_For_Primitive_Subprogram;
+
+      -----------------------------------
+      -- Check_Synchronized_Overriding --
+      -----------------------------------
+
+      procedure Check_Synchronized_Overriding
+        (Def_Id          : Entity_Id;
+         First_Hom       : Entity_Id;
+         Overridden_Subp : out Entity_Id)
+      is
+         Formal_Typ  : Entity_Id;
+         Ifaces_List : Elist_Id;
+         In_Scope    : Boolean;
+         Typ         : Entity_Id;
+
+      begin
+         Overridden_Subp := Empty;
+
+         --  Def_Id must be an entry or a subprogram
+
+         if Ekind (Def_Id) /= E_Entry
+           and then Ekind (Def_Id) /= E_Function
+           and then Ekind (Def_Id) /= E_Procedure
+         then
+            return;
+         end if;
+
+         --  Search for the concurrent declaration since it contains the list
+         --  of all implemented interfaces. In this case, the subprogram is
+         --  declared within the scope of a protected or a task type.
+
+         if Present (Scope (Def_Id))
+           and then Is_Concurrent_Type (Scope (Def_Id))
+           and then not Is_Generic_Actual_Type (Scope (Def_Id))
+         then
+            Typ := Scope (Def_Id);
+            In_Scope := True;
+
+         --  The subprogram may be a primitive of a concurrent type
+
+         elsif Present (First_Formal (Def_Id)) then
+            Formal_Typ := Etype (First_Formal (Def_Id));
+
+            if Is_Concurrent_Type (Formal_Typ)
+              and then not Is_Generic_Actual_Type (Formal_Typ)
+            then
+               Typ := Formal_Typ;
+               In_Scope := False;
+
+            --  This case occurs when the concurrent type is declared within
+            --  a generic unit. As a result the corresponding record has been
+            --  built and used as the type of the first formal, we just have
+            --  to retrieve the corresponding concurrent type.
+
+            elsif Is_Concurrent_Record_Type (Formal_Typ)
+              and then Present (Corresponding_Concurrent_Type (Formal_Typ))
+            then
+               Typ := Corresponding_Concurrent_Type (Formal_Typ);
+               In_Scope := False;
+
+            else
+               return;
+            end if;
+         else
+            return;
+         end if;
+
+         --  Gather all limited, protected and task interfaces that Typ
+         --  implements. There is no overriding to check if is an inherited
+         --  operation in a type derivation on for a generic actual.
+
+         if Nkind (Parent (Typ)) /= N_Full_Type_Declaration
+           and then Nkind (Parent (Def_Id)) /= N_Subtype_Declaration
+           and then Nkind (Parent (Def_Id)) /= N_Task_Type_Declaration
+           and then Nkind (Parent (Def_Id)) /= N_Protected_Type_Declaration
+         then
+            Collect_Abstract_Interfaces (Typ, Ifaces_List);
+
+            if not Is_Empty_Elmt_List (Ifaces_List) then
+               Overridden_Subp :=
+                 Find_Overridden_Synchronized_Primitive
+                   (Def_Id, First_Hom, Ifaces_List, In_Scope);
+            end if;
+         end if;
+      end Check_Synchronized_Overriding;
+
+      ----------------------------
+      -- Is_Private_Declaration --
+      ----------------------------
+
+      function Is_Private_Declaration (E : Entity_Id) return Boolean is
+         Priv_Decls : List_Id;
+         Decl       : constant Node_Id := Unit_Declaration_Node (E);
+
+      begin
+         if Is_Package_Or_Generic_Package (Current_Scope)
+           and then In_Private_Part (Current_Scope)
+         then
+            Priv_Decls :=
+              Private_Declarations (
+                Specification (Unit_Declaration_Node (Current_Scope)));
+
+            return In_Package_Body (Current_Scope)
+              or else
+                (Is_List_Member (Decl)
+                   and then List_Containing (Decl) = Priv_Decls)
+              or else (Nkind (Parent (Decl)) = N_Package_Specification
+                         and then not Is_Compilation_Unit (
+                           Defining_Entity (Parent (Decl)))
+                         and then List_Containing (Parent (Parent (Decl)))
+                           = Priv_Decls);
+         else
+            return False;
+         end if;
+      end Is_Private_Declaration;
 
    --  Start of processing for New_Overloaded_Entity
 
@@ -6208,14 +6267,15 @@ package body Sem_Ch6 is
       if No (E) then
          Enter_Overloaded_Entity (S);
          Check_Dispatching_Operation (S, Empty);
-         Maybe_Primitive_Operation;
+         Check_For_Primitive_Subprogram (Is_Primitive_Subp);
 
          --  If subprogram has an explicit declaration, check whether it
          --  has an overriding indicator.
 
          if Comes_From_Source (S) then
             Check_Synchronized_Overriding (S, Homonym (S), Overridden_Subp);
-            Check_Overriding_Indicator (S, Overridden_Subp);
+            Check_Overriding_Indicator
+              (S, Overridden_Subp, Is_Primitive => Is_Primitive_Subp);
          end if;
 
       --  If there is a homonym that is not overloadable, then we have an
@@ -6241,7 +6301,7 @@ package body Sem_Ch6 is
             Enter_Overloaded_Entity (S);
             Set_Homonym (S, Homonym (E));
             Check_Dispatching_Operation (S, Empty);
-            Check_Overriding_Indicator (S, Empty);
+            Check_Overriding_Indicator (S, Empty, Is_Primitive => False);
 
          --  If the subprogram is implicit it is hidden by the previous
          --  declaration. However if it is dispatching, it must appear in the
@@ -6261,12 +6321,14 @@ package body Sem_Ch6 is
 
          else
             Error_Msg_Sloc := Sloc (E);
-            Error_Msg_N ("& conflicts with declaration#", S);
 
-            --  Useful additional warning
+            --  Generate message,with useful additionalwarning if in generic
 
             if Is_Generic_Unit (E) then
-               Error_Msg_N ("\previous generic unit cannot be overloaded", S);
+               Error_Msg_N ("previous generic unit cannot be overloaded", S);
+               Error_Msg_N ("\& conflicts with declaration#", S);
+            else
+               Error_Msg_N ("& conflicts with declaration#", S);
             end if;
 
             return;
@@ -6349,7 +6411,7 @@ package body Sem_Ch6 is
                   Set_Is_Overriding_Operation (E);
 
                   if Comes_From_Source (E) then
-                     Check_Overriding_Indicator (E, S);
+                     Check_Overriding_Indicator (E, S, Is_Primitive => False);
 
                      --  Indicate that E overrides the operation from which
                      --  S is inherited.
@@ -6513,7 +6575,7 @@ package body Sem_Ch6 is
 
                      Enter_Overloaded_Entity (S);
                      Set_Is_Overriding_Operation (S);
-                     Check_Overriding_Indicator (S, E);
+                     Check_Overriding_Indicator (S, E, Is_Primitive => True);
 
                      --  Indicate that S overrides the operation from which
                      --  E is inherited.
@@ -6539,7 +6601,8 @@ package body Sem_Ch6 is
                         Check_Dispatching_Operation (S, Empty);
                      end if;
 
-                     Maybe_Primitive_Operation (Is_Overriding => True);
+                     Check_For_Primitive_Subprogram
+                       (Is_Primitive_Subp, Is_Overriding => True);
                      goto Check_Inequality;
                   end;
 
@@ -6567,13 +6630,17 @@ package body Sem_Ch6 is
 
                   Set_Scope (S, Current_Scope);
 
-                  Error_Msg_N ("& conflicts with declaration#", S);
+                  --  Generate error, with extra useful warning for the case
+                  --  of a generic instance with no completion.
 
                   if Is_Generic_Instance (S)
                     and then not Has_Completion (E)
                   then
                      Error_Msg_N
-                       ("\instantiation cannot provide body for it", S);
+                       ("instantiation cannot provide body for&", S);
+                     Error_Msg_N ("\& conflicts with declaration#", S);
+                  else
+                     Error_Msg_N ("& conflicts with declaration#", S);
                   end if;
 
                   return;
@@ -6632,8 +6699,9 @@ package body Sem_Ch6 is
          --  On exit, we know that S is a new entity
 
          Enter_Overloaded_Entity (S);
-         Maybe_Primitive_Operation;
-         Check_Overriding_Indicator (S, Overridden_Subp);
+         Check_For_Primitive_Subprogram (Is_Primitive_Subp);
+         Check_Overriding_Indicator
+           (S, Overridden_Subp, Is_Primitive => Is_Primitive_Subp);
 
          --  If S is a derived operation for an untagged type then by
          --  definition it's not a dispatching operation (even if the parent
@@ -6701,10 +6769,9 @@ package body Sem_Ch6 is
       --  analyzed. The Ekind is established in a separate loop at the end.
 
       Param_Spec := First (T);
-
       while Present (Param_Spec) loop
-
          Formal := Defining_Identifier (Param_Spec);
+         Set_Never_Set_In_Source (Formal, True);
          Enter_Name (Formal);
 
          --  Case of ordinary parameters

gcc/ada/sem_ch6.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -39,7 +39,7 @@ package Sem_Ch6 is
    procedure Analyze_Operator_Symbol                 (N : Node_Id);
    procedure Analyze_Parameter_Association           (N : Node_Id);
    procedure Analyze_Procedure_Call                  (N : Node_Id);
-   procedure Analyze_Return_Statement                (N : Node_Id);
+   procedure Analyze_Simple_Return_Statement         (N : Node_Id);
    procedure Analyze_Subprogram_Declaration          (N : Node_Id);
    procedure Analyze_Subprogram_Body                 (N : Node_Id);