Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(révision 116503)
--- gcc/fortran/resolve.c	(copie de travail)
*************** generic:
*** 1181,1187 ****
  
    if (!gfc_generic_intrinsic (expr->symtree->n.sym->name))
      {
!       gfc_error ("Generic function '%s' at %L is not an intrinsic function",
  		 expr->symtree->n.sym->name, &expr->where);
        return FAILURE;
      }
--- 1181,1187 ----
  
    if (!gfc_generic_intrinsic (expr->symtree->n.sym->name))
      {
!       gfc_error ("There is no specific function for the generic '%s' at %L",
  		 expr->symtree->n.sym->name, &expr->where);
        return FAILURE;
      }
*************** resolve_generic_s (gfc_code * c)
*** 1614,1644 ****
  
    sym = c->symtree->n.sym;
  
!   m = resolve_generic_s0 (c, sym);
!   if (m == MATCH_YES)
!     return SUCCESS;
!   if (m == MATCH_ERROR)
!     return FAILURE;
! 
!   if (sym->ns->parent != NULL && !sym->attr.use_assoc)
      {
        gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
!       if (sym != NULL)
! 	{
! 	  m = resolve_generic_s0 (c, sym);
! 	  if (m == MATCH_YES)
! 	    return SUCCESS;
! 	  if (m == MATCH_ERROR)
! 	    return FAILURE;
! 	}
      }
  
    /* Last ditch attempt.  */
! 
    if (!gfc_generic_intrinsic (sym->name))
      {
        gfc_error
! 	("Generic subroutine '%s' at %L is not an intrinsic subroutine",
  	 sym->name, &c->loc);
        return FAILURE;
      }
--- 1614,1644 ----
  
    sym = c->symtree->n.sym;
  
!   for (;;)
      {
+       m = resolve_generic_s0 (c, sym);
+       if (m == MATCH_YES)
+ 	return SUCCESS;
+       else if (m == MATCH_ERROR)
+ 	return FAILURE;
+ 
+ generic:
+       if (sym->ns->parent == NULL)
+ 	break;
        gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
! 
!       if (sym == NULL)
! 	break;
!       if (!generic_sym (sym))
! 	goto generic;
      }
  
    /* Last ditch attempt.  */
!   sym = c->symtree->n.sym;
    if (!gfc_generic_intrinsic (sym->name))
      {
        gfc_error
! 	("There is no specific subroutine for the generic '%s' at %L",
  	 sym->name, &c->loc);
        return FAILURE;
      }
*************** resolve_specific_s (gfc_code * c)
*** 1708,1730 ****
  
    sym = c->symtree->n.sym;
  
!   m = resolve_specific_s0 (c, sym);
!   if (m == MATCH_YES)
!     return SUCCESS;
!   if (m == MATCH_ERROR)
!     return FAILURE;
! 
!   gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
! 
!   if (sym != NULL)
      {
        m = resolve_specific_s0 (c, sym);
        if (m == MATCH_YES)
  	return SUCCESS;
        if (m == MATCH_ERROR)
  	return FAILURE;
      }
  
    gfc_error ("Unable to resolve the specific subroutine '%s' at %L",
  	     sym->name, &c->loc);
  
--- 1708,1731 ----
  
    sym = c->symtree->n.sym;
  
!   for (;;)
      {
        m = resolve_specific_s0 (c, sym);
        if (m == MATCH_YES)
  	return SUCCESS;
        if (m == MATCH_ERROR)
  	return FAILURE;
+ 
+       if (sym->ns->parent == NULL)
+ 	break;
+ 
+       gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
+ 
+       if (sym == NULL)
+ 	break;
      }
  
+   sym = c->symtree->n.sym;
    gfc_error ("Unable to resolve the specific subroutine '%s' at %L",
  	     sym->name, &c->loc);
  
Index: gcc/testsuite/gfortran.dg/generic_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_5.f90	(révision 116503)
--- gcc/testsuite/gfortran.dg/generic_5.f90	(copie de travail)
*************** MODULE provoke_ice
*** 23,29 ****
  CONTAINS
    SUBROUTINE provoke
      USE ice_gfortran
!     CALL ice(23.0)   ! { dg-error "is not an intrinsic subroutine" }
    END SUBROUTINE
  END MODULE
! 
--- 23,29 ----
  CONTAINS
    SUBROUTINE provoke
      USE ice_gfortran
!     CALL ice(23.0)   ! { dg-error "no specific subroutine" }
    END SUBROUTINE
  END MODULE
! ! { dg-final { cleanup-modules "ice_gfortran provoke_ice" } }
Index: gcc/testsuite/gfortran.dg/generic_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_6.f90	(révision 0)
--- gcc/testsuite/gfortran.dg/generic_6.f90	(révision 0)
***************
*** 0 ****
--- 1,49 ----
+ ! { dg-do compile }
+ ! Tests the patch for PR28873, in which the call create () would cause an
+ ! error because resolve.c(resolve_generic_s) was failing to look in the
+ ! parent namespace for a matching specific subroutine. This, in fact, was
+ ! a regression due to the fix for PR28201.
+ !
+ ! Contributed by Drew McCormack  <drewmccormack@mac.com> 
+ !
+ module A
+   private 
+   interface create
+     module procedure create1 
+   end interface
+   public :: create
+ contains
+   subroutine create1
+     print *, "module A"
+   end subroutine
+ end module
+ 
+ module B
+   private 
+   interface create
+     module procedure create1 
+   end interface
+   public :: create
+ contains
+   subroutine create1(a)
+     integer a
+     print *, "module B"
+   end subroutine
+ end module
+ 
+ module C
+   use A
+   private
+   public useCreate
+ contains
+   subroutine useCreate
+     use B
+     call create()
+     call create(1)
+   end subroutine
+ end module
+ 
+   use c
+   call useCreate
+ end
+ ! { dg-final { cleanup-modules "A B C" } }