Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 161198)
+++ sem_ch3.adb	(working copy)
@@ -68,6 +68,7 @@ with Sem_Util; use Sem_Util;
 with Sem_Warn; use Sem_Warn;
 with Stand;    use Stand;
 with Sinfo;    use Sinfo;
+with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
@@ -1537,90 +1538,92 @@ package body Sem_Ch3 is
       while Present (Iface_Elmt) loop
          Iface := Node (Iface_Elmt);
 
-         --  Exclude from this processing interfaces that are parents of
-         --  Tagged_Type because their primitives are located in the primary
-         --  dispatch table (and hence no auxiliary internal entities are
-         --  required to handle secondary dispatch tables in such case).
+         --  Originally we excluded here from this processing interfaces that
+         --  are parents of Tagged_Type because their primitives are located
+         --  in the primary dispatch table (and hence no auxiliary internal
+         --  entities are required to handle secondary dispatch tables in such
+         --  case). However, these auxiliary entities are also required to
+         --  handle derivations of interfaces in formals of generics (see
+         --  Derive_Subprograms).
 
-         if not Is_Ancestor (Iface, Tagged_Type) then
-            Elmt := First_Elmt (Primitive_Operations (Iface));
-            while Present (Elmt) loop
-               Iface_Prim := Node (Elmt);
-
-               if not Is_Predefined_Dispatching_Operation (Iface_Prim) then
-                  Prim :=
-                    Find_Primitive_Covering_Interface
-                      (Tagged_Type => Tagged_Type,
-                       Iface_Prim  => Iface_Prim);
+         Elmt := First_Elmt (Primitive_Operations (Iface));
+         while Present (Elmt) loop
+            Iface_Prim := Node (Elmt);
 
-                  if No (Prim) then
+            if not Is_Predefined_Dispatching_Operation (Iface_Prim) then
+               Prim :=
+                 Find_Primitive_Covering_Interface
+                   (Tagged_Type => Tagged_Type,
+                    Iface_Prim  => Iface_Prim);
+
+               if No (Prim) then
+
+                  --  In some rare cases, a name conflict may have kept the
+                  --  operation completely hidden. Look for it in the list
+                  --  of primitive operations of the type.
 
-                     --  In some rare cases, a name conflict may have kept the
-                     --  operation completely hidden. Look for it in the list
-                     --  of primitive operations of the type.
+                  declare
+                     El : Elmt_Id;
 
-                     declare
-                        El : Elmt_Id;
-                     begin
-                        El := First_Elmt (Primitive_Operations (Tagged_Type));
-                        while Present (El) loop
-                           Prim := Node (El);
-                           exit when Is_Subprogram (Prim)
-                             and then Alias (Prim) = Iface_Prim;
-                           Next_Elmt (El);
-                        end loop;
+                  begin
+                     El := First_Elmt (Primitive_Operations (Tagged_Type));
+                     while Present (El) loop
+                        Prim := Node (El);
+                        exit when Is_Subprogram (Prim)
+                          and then Alias (Prim) = Iface_Prim;
+                        Next_Elmt (El);
+                     end loop;
 
-                        --  If the operation was not explicitly overridden, it
-                        --  should have been inherited as an abstract operation
-                        --  so Prim can not be Empty at this stage.
+                     --  If the operation was not explicitly overridden, it
+                     --  should have been inherited as an abstract operation
+                     --  so Prim can not be Empty at this stage.
 
-                        if No (El) then
-                           raise Program_Error;
-                        end if;
-                     end;
-                  end if;
+                     if No (El) then
+                        raise Program_Error;
+                     end if;
+                  end;
+               end if;
 
-                  Derive_Subprogram
-                    (New_Subp     => New_Subp,
-                     Parent_Subp  => Iface_Prim,
-                     Derived_Type => Tagged_Type,
-                     Parent_Type  => Iface);
-
-                  --  Ada 2005 (AI-251): Decorate internal entity Iface_Subp
-                  --  associated with interface types. These entities are
-                  --  only registered in the list of primitives of its
-                  --  corresponding tagged type because they are only used
-                  --  to fill the contents of the secondary dispatch tables.
-                  --  Therefore they are removed from the homonym chains.
-
-                  Set_Is_Hidden (New_Subp);
-                  Set_Is_Internal (New_Subp);
-                  Set_Alias (New_Subp, Prim);
-                  Set_Is_Abstract_Subprogram (New_Subp,
-                    Is_Abstract_Subprogram (Prim));
-                  Set_Interface_Alias (New_Subp, Iface_Prim);
-
-                  --  Internal entities associated with interface types are
-                  --  only registered in the list of primitives of the tagged
-                  --  type. They are only used to fill the contents of the
-                  --  secondary dispatch tables. Therefore they are not needed
-                  --  in the homonym chains.
-
-                  Remove_Homonym (New_Subp);
-
-                  --  Hidden entities associated with interfaces must have set
-                  --  the Has_Delay_Freeze attribute to ensure that, in case of
-                  --  locally defined tagged types (or compiling with static
-                  --  dispatch tables generation disabled) the corresponding
-                  --  entry of the secondary dispatch table is filled when
-                  --  such an entity is frozen.
+               Derive_Subprogram
+                 (New_Subp     => New_Subp,
+                  Parent_Subp  => Iface_Prim,
+                  Derived_Type => Tagged_Type,
+                  Parent_Type  => Iface);
+
+               --  Ada 2005 (AI-251): Decorate internal entity Iface_Subp
+               --  associated with interface types. These entities are
+               --  only registered in the list of primitives of its
+               --  corresponding tagged type because they are only used
+               --  to fill the contents of the secondary dispatch tables.
+               --  Therefore they are removed from the homonym chains.
+
+               Set_Is_Hidden (New_Subp);
+               Set_Is_Internal (New_Subp);
+               Set_Alias (New_Subp, Prim);
+               Set_Is_Abstract_Subprogram
+                 (New_Subp, Is_Abstract_Subprogram (Prim));
+               Set_Interface_Alias (New_Subp, Iface_Prim);
+
+               --  Internal entities associated with interface types are
+               --  only registered in the list of primitives of the tagged
+               --  type. They are only used to fill the contents of the
+               --  secondary dispatch tables. Therefore they are not needed
+               --  in the homonym chains.
+
+               Remove_Homonym (New_Subp);
+
+               --  Hidden entities associated with interfaces must have set
+               --  the Has_Delay_Freeze attribute to ensure that, in case of
+               --  locally defined tagged types (or compiling with static
+               --  dispatch tables generation disabled) the corresponding
+               --  entry of the secondary dispatch table is filled when
+               --  such an entity is frozen.
 
-                  Set_Has_Delayed_Freeze (New_Subp);
-               end if;
+               Set_Has_Delayed_Freeze (New_Subp);
+            end if;
 
-               Next_Elmt (Elmt);
-            end loop;
-         end if;
+            Next_Elmt (Elmt);
+         end loop;
 
          Next_Elmt (Iface_Elmt);
       end loop;
@@ -11955,7 +11958,7 @@ package body Sem_Ch3 is
       --  non-abstract tagged types that can reference abstract primitives
       --  through its Alias attribute are the internal entities that have
       --  attribute Interface_Alias, and these entities are generated later
-      --  by Freeze_Record_Type).
+      --  by Add_Internal_Interface_Entities).
 
       if In_Private_Part (Current_Scope)
         and then Is_Abstract_Type (Parent_Type)
@@ -12734,6 +12737,12 @@ package body Sem_Ch3 is
             --  corresponding operations of the actual.
 
             else
+               pragma Assert (No (Node (Act_Elmt))
+                 or else (Primitive_Names_Match (Subp, Node (Act_Elmt))
+                            and then
+                          Type_Conformant (Subp, Node (Act_Elmt),
+                                           Skip_Controlling_Formals => True)));
+
                Derive_Subprogram
                  (New_Subp, Subp, Derived_Type, Parent_Base, Node (Act_Elmt));
 
@@ -12839,7 +12848,11 @@ package body Sem_Ch3 is
               or else
                 (Present (Generic_Actual)
                   and then Present (Act_Subp)
-                  and then not Primitive_Names_Match (Subp, Act_Subp))
+                  and then not
+                    (Primitive_Names_Match (Subp, Act_Subp)
+                       and then
+                     Type_Conformant (Subp, Act_Subp,
+                                      Skip_Controlling_Formals => True)))
             then
                pragma Assert (not Is_Ancestor (Parent_Base, Generic_Actual));
 
@@ -12849,14 +12862,73 @@ package body Sem_Ch3 is
 
                --  Handle entities associated with interface primitives
 
-               if Present (Alias (Subp))
-                 and then Is_Interface (Find_Dispatching_Type (Alias (Subp)))
+               if Present (Alias_Subp)
+                 and then Is_Interface (Find_Dispatching_Type (Alias_Subp))
                  and then not Is_Predefined_Dispatching_Operation (Subp)
                then
+                  --  Search for the primitive in the homonym chain
+
                   Act_Subp :=
                     Find_Primitive_Covering_Interface
                       (Tagged_Type => Generic_Actual,
-                       Iface_Prim  => Subp);
+                       Iface_Prim  => Alias_Subp);
+
+                  --  Previous search may not locate primitives covering
+                  --  interfaces defined in generics units or instantiations.
+                  --  (it fails if the covering primitive has formals whose
+                  --  type is also defined in generics or instantiations).
+                  --  In such case we search in the list of primitives of the
+                  --  generic actual for the internal entity that links the
+                  --  interface primitive and the covering primitive.
+
+                  if No (Act_Subp)
+                    and then Is_Generic_Type (Parent_Type)
+                  then
+                     --  This code has been designed to handle only generic
+                     --  formals that implement interfaces that are defined
+                     --  in a generic unit or instantiation. If this code is
+                     --  needed for other cases we must review it because
+                     --  (given that it relies on Original_Location to locate
+                     --  the primitive of Generic_Actual that covers the
+                     --  interface) it could leave linked through attribute
+                     --  Alias entities of unrelated instantiations).
+
+                     pragma Assert
+                       (Is_Generic_Unit
+                          (Scope (Find_Dispatching_Type (Alias_Subp)))
+                       or else
+                        Instantiation_Depth
+                          (Sloc (Find_Dispatching_Type (Alias_Subp))) > 0);
+
+                     declare
+                        Iface_Prim_Loc : constant Source_Ptr :=
+                                         Original_Location (Sloc (Alias_Subp));
+                        Elmt      : Elmt_Id;
+                        Prim      : Entity_Id;
+                     begin
+                        Elmt :=
+                          First_Elmt (Primitive_Operations (Generic_Actual));
+
+                        Search : while Present (Elmt) loop
+                           Prim := Node (Elmt);
+
+                           if Present (Interface_Alias (Prim))
+                             and then Original_Location
+                                        (Sloc (Interface_Alias (Prim)))
+                                       = Iface_Prim_Loc
+                           then
+                              Act_Subp := Alias (Prim);
+                              exit Search;
+                           end if;
+
+                           Next_Elmt (Elmt);
+                        end loop Search;
+                     end;
+                  end if;
+
+                  pragma Assert (Present (Act_Subp)
+                    or else Is_Abstract_Type (Generic_Actual)
+                    or else Serious_Errors_Detected > 0);
 
                --  Handle predefined primitives plus the rest of user-defined
                --  primitives
@@ -12874,6 +12946,10 @@ package body Sem_Ch3 is
 
                      Next_Elmt (Act_Elmt);
                   end loop;
+
+                  if No (Act_Elmt) then
+                     Act_Subp := Empty;
+                  end if;
                end if;
             end if;
 
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 161244)
+++ sem_util.adb	(working copy)
@@ -4497,15 +4497,13 @@ package body Sem_Util is
      (T             : Entity_Id;
       Use_Full_View : Boolean := True) return Boolean
    is
-      Typ : Entity_Id;
+      Typ : Entity_Id := Base_Type (T);
 
    begin
       --  Handle concurrent types
 
-      if Is_Concurrent_Type (T) then
-         Typ := Corresponding_Record_Type (T);
-      else
-         Typ := T;
+      if Is_Concurrent_Type (Typ) then
+         Typ := Corresponding_Record_Type (Typ);
       end if;
 
       if not Present (Typ)
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 161244)
+++ sem_ch6.adb	(working copy)
@@ -4568,7 +4568,7 @@ package body Sem_Ch6 is
 
             elsif Must_Override (Spec) then
                if Is_Overriding_Operation (Subp) then
-                  Set_Is_Overriding_Operation (Subp);
+                  null;
 
                elsif not Can_Override then
                   Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
@@ -6477,8 +6477,8 @@ package body Sem_Ch6 is
         or else Etype (Prim) = Etype (Iface_Prim)
         or else not Has_Controlling_Result (Prim)
       then
-         return Type_Conformant (Prim, Iface_Prim,
-                  Skip_Controlling_Formals => True);
+         return Type_Conformant
+                  (Iface_Prim, Prim, Skip_Controlling_Formals => True);
 
       --  Case of a function returning an interface, or an access to one.
       --  Check that the return types correspond.
Index: exp_disp.adb
===================================================================
--- exp_disp.adb	(revision 161244)
+++ exp_disp.adb	(working copy)
@@ -6014,6 +6014,9 @@ package body Exp_Disp is
             --  Look for primitive overriding an abstract interface subprogram
 
             if Present (Interface_Alias (Prim))
+              and then not
+                Is_Ancestor
+                  (Find_Dispatching_Type (Interface_Alias (Prim)), Typ)
               and then not Examined (UI_To_Int (DT_Position (Alias (Prim))))
             then
                Prim_Pos := DT_Position (Alias (Prim));
@@ -6721,6 +6724,13 @@ package body Exp_Disp is
 
          pragma Assert (Is_Interface (Iface_Typ));
 
+         --  No action needed for interfaces that are ancestors of Typ because
+         --  their primitives are located in the primary dispatch table.
+
+         if Is_Ancestor (Iface_Typ, Tag_Typ) then
+            return L;
+         end if;
+
          Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code);
 
          if not Is_Ancestor (Iface_Typ, Tag_Typ)
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 161073)
+++ sem_ch13.adb	(working copy)
@@ -2366,7 +2366,9 @@ package body Sem_Ch13 is
       --  code because their main purpose was to provide support to initialize
       --  the secondary dispatch tables. They are now generated also when
       --  compiling with no code generation to provide ASIS the relationship
-      --  between interface primitives and tagged type primitives.
+      --  between interface primitives and tagged type primitives. They are
+      --  also used to locate primitives covering interfaces when processing
+      --  generics (see Derive_Subprograms).
 
       if Ada_Version >= Ada_05
         and then Ekind (E) = E_Record_Type
@@ -2374,6 +2376,12 @@ package body Sem_Ch13 is
         and then not Is_Interface (E)
         and then Has_Interfaces (E)
       then
+         --  This would be a good common place to call the routine that checks
+         --  overriding of interface primitives (and thus factorize calls to
+         --  Check_Abstract_Overriding located at different contexts in the
+         --  compiler). However, this is not possible because it causes
+         --  spurious errors in case of late overriding.
+
          Add_Internal_Interface_Entities (E);
       end if;
    end Analyze_Freeze_Entity;
Index: exp_cg.adb
===================================================================
--- exp_cg.adb	(revision 161205)
+++ exp_cg.adb	(working copy)
@@ -572,7 +572,11 @@ package body Exp_CG is
                   Prim_Op := Node (Prim_Elmt);
                   Int_Alias := Interface_Alias (Prim_Op);
 
-                  if Present (Int_Alias) and then (Alias (Prim_Op)) = Prim then
+                  if Present (Int_Alias)
+                    and then not Is_Ancestor
+                                   (Find_Dispatching_Type (Int_Alias), Typ)
+                    and then (Alias (Prim_Op)) = Prim
+                  then
                      Write_Char (',');
                      Write_Int (UI_To_Int (Slot_Number (Int_Alias)));
                      Write_Char (':');
