Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 164906)
+++ sem_ch3.adb	(working copy)
@@ -1567,41 +1567,9 @@ package body Sem_Ch3 is
                   if Is_Null_Interface_Primitive (Iface_Prim) then
                      goto Continue;
 
-                  --  if the tagged type is defined at library level then we
-                  --  invoke Check_Abstract_Overriding to report the error
-                  --  and thus avoid generating the dispatch tables.
-
-                  elsif Is_Library_Level_Tagged_Type (Tagged_Type) then
-                     Check_Abstract_Overriding (Tagged_Type);
-                     pragma Assert (Serious_Errors_Detected > 0);
-                     return;
-
-                  --  For tagged types defined in nested scopes it is still
-                  --  possible to cover this interface primitive by means of
-                  --  late overriding (see Override_Dispatching_Operation).
-
-                  --  Search in the list of primitives of the type for the
-                  --  entity that will be overridden in such case to reference
-                  --  it in the internal entity that we build here. If the
-                  --  primitive is not overridden then the error will be
-                  --  reported later as part of the analysis of entities
-                  --  defined in the enclosing scope.
-
                   else
-                     declare
-                        El : Elmt_Id;
-
-                     begin
-                        El := First_Elmt (Primitive_Operations (Tagged_Type));
-                        while Present (El)
-                          and then Alias (Node (El)) /= Iface_Prim
-                        loop
-                           Next_Elmt (El);
-                        end loop;
-
-                        pragma Assert (Present (El));
-                        Prim := Node (El);
-                     end;
+                     pragma Assert (False);
+                     raise Program_Error;
                   end if;
                end if;
 
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 164933)
+++ sem_ch6.adb	(working copy)
@@ -7625,6 +7625,7 @@ package body Sem_Ch6 is
 
          if Ada_Version >= Ada_05
            and then Present (Derived_Type)
+           and then Present (Alias (S))
            and then Is_Dispatching_Operation (Alias (S))
            and then Present (Find_Dispatching_Type (Alias (S)))
            and then Is_Interface (Find_Dispatching_Type (Alias (S)))
Index: sem_disp.adb
===================================================================
--- sem_disp.adb	(revision 164939)
+++ sem_disp.adb	(working copy)
@@ -1651,7 +1651,8 @@ package body Sem_Disp is
      (Tagged_Type : Entity_Id;
       Iface_Prim  : Entity_Id) return Entity_Id
    is
-      E : Entity_Id;
+      E  : Entity_Id;
+      El : Elmt_Id;
 
    begin
       pragma Assert (Is_Interface (Find_Dispatching_Type (Iface_Prim))
@@ -1660,6 +1661,8 @@ package body Sem_Disp is
                      Is_Interface
                        (Find_Dispatching_Type (Ultimate_Alias (Iface_Prim)))));
 
+      --  Search in the homonym chain
+
       E := Current_Entity (Iface_Prim);
       while Present (E) loop
          if Is_Subprogram (E)
@@ -1672,6 +1675,23 @@ package body Sem_Disp is
          E := Homonym (E);
       end loop;
 
+      --  Search in the list of primitives of the type
+
+      El := First_Elmt (Primitive_Operations (Tagged_Type));
+      while Present (El) loop
+         E := Node (El);
+
+         if No (Interface_Alias (E))
+           and then Alias (E) = Iface_Prim
+         then
+            return Node (El);
+         end if;
+
+         Next_Elmt (El);
+      end loop;
+
+      --  Not found
+
       return Empty;
    end Find_Primitive_Covering_Interface;
 
Index: sem_disp.ads
===================================================================
--- sem_disp.ads	(revision 164906)
+++ sem_disp.ads	(working copy)
@@ -82,10 +82,12 @@ package Sem_Disp is
    function Find_Primitive_Covering_Interface
      (Tagged_Type : Entity_Id;
       Iface_Prim  : Entity_Id) return Entity_Id;
-   --  Search in the homonym chain for the primitive of Tagged_Type that
-   --  covers Iface_Prim. The homonym chain traversal is required to catch
-   --  primitives associated with the partial view of private types when
-   --  processing the corresponding full view.
+   --  Search in the homonym chain for the primitive of Tagged_Type that covers
+   --  Iface_Prim. The homonym chain traversal is required to catch primitives
+   --  associated with the partial view of private types when processing the
+   --  corresponding full view. If the entity is not found then search for it
+   --  in the list of primitives of Tagged_Type. This latter search is needed
+   --  when the interface primitive is covered by a private subprogram.
 
    function Is_Dynamically_Tagged (N : Node_Id) return Boolean;
    --  Used to determine whether a call is dispatching, i.e. if is an