Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 188819)
+++ gcc/fortran/interface.c	(working copy)
@@ -826,12 +826,13 @@ bad_repl:
    a given type/rank in f1 and seeing if there are less then that
    number of those arguments in f2 (including optional arguments).
    Since this test is asymmetric, it has to be called twice to make it
-   symmetric.  Returns nonzero if the argument lists are incompatible
-   by this test.  This subroutine implements rule 1 of section
-   14.1.2.3 in the Fortran 95 standard.  */
+   symmetric. Returns nonzero if the argument lists are incompatible
+   by this test. This subroutine implements rule 1 of section F03:16.2.3.
+   'p1' and 'p2' are the PASS arguments of both procedures (if applicable).  */
 
 static int
-count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
+count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2,
+		  const char *p1, const char *p2)
 {
   int rc, ac1, ac2, i, j, k, n1;
   gfc_formal_arglist *f;
@@ -868,14 +869,17 @@ static int
       if (arg[i].flag != -1)
 	continue;
 
-      if (arg[i].sym && arg[i].sym->attr.optional)
-	continue;		/* Skip optional arguments.  */
+      if (arg[i].sym && (arg[i].sym->attr.optional
+			 || (p1 && strcmp (arg[i].sym->name, p1) == 0)))
+	continue;		/* Skip OPTIONAL and PASS arguments.  */
 
       arg[i].flag = k;
 
-      /* Find other nonoptional arguments of the same type/rank.  */
+      /* Find other non-optional, non-pass arguments of the same type/rank.  */
       for (j = i + 1; j < n1; j++)
-	if ((arg[j].sym == NULL || !arg[j].sym->attr.optional)
+	if ((arg[j].sym == NULL
+	     || !(arg[j].sym->attr.optional
+		  || (p1 && strcmp (arg[j].sym->name, p1) == 0)))
 	    && (compare_type_rank_if (arg[i].sym, arg[j].sym)
 	        || compare_type_rank_if (arg[j].sym, arg[i].sym)))
 	  arg[j].flag = k;
@@ -897,13 +901,14 @@ static int
 	if (arg[j].flag == k)
 	  ac1++;
 
-      /* Count the number of arguments in f2 with that type, including
-	 those that are optional.  */
+      /* Count the number of non-pass arguments in f2 with that type,
+	 including those that are optional.  */
       ac2 = 0;
 
       for (f = f2; f; f = f->next)
-	if (compare_type_rank_if (arg[i].sym, f->sym)
-	    || compare_type_rank_if (f->sym, arg[i].sym))
+	if ((!p2 || strcmp (f->sym->name, p2) != 0)
+	    && (compare_type_rank_if (arg[i].sym, f->sym)
+		|| compare_type_rank_if (f->sym, arg[i].sym)))
 	  ac2++;
 
       if (ac1 > ac2)
@@ -921,9 +926,10 @@ static int
 }
 
 
-/* Perform the correspondence test in rule 2 of section 14.1.2.3.
-   Returns zero if no argument is found that satisfies rule 2, nonzero
-   otherwise.
+/* Perform the correspondence test in rule 3 of section F03:16.2.3.
+   Returns zero if no argument is found that satisfies rule 3, nonzero
+   otherwise. 'p1' and 'p2' are the PASS arguments of both procedures
+   (if applicable).
 
    This test is also not symmetric in f1 and f2 and must be called
    twice.  This test finds problems caused by sorting the actual
@@ -942,7 +948,8 @@ static int
    At this point, 'CALL FOO(A=1, B=1.0)' is ambiguous.  */
 
 static int
-generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
+generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2,
+			const char *p1, const char *p2)
 {
   gfc_formal_arglist *f2_save, *g;
   gfc_symbol *sym;
@@ -954,6 +961,11 @@ static int
       if (f1->sym->attr.optional)
 	goto next;
 
+      if (p1 && strcmp (f1->sym->name, p1) == 0)
+	f1 = f1->next;
+      if (f2 && p2 && strcmp (f2->sym->name, p2) == 0)
+	f2 = f2->next;
+
       if (f2 != NULL && (compare_type_rank (f1->sym, f2->sym)
 			 || compare_type_rank (f2->sym, f1->sym)))
 	goto next;
@@ -962,7 +974,7 @@ static int
 	 the current non-match.  */
       for (g = f1; g; g = g->next)
 	{
-	  if (g->sym->attr.optional)
+	  if (g->sym->attr.optional || (p1 && strcmp (g->sym->name, p1) == 0))
 	    continue;
 
 	  sym = find_keyword_arg (g->sym->name, f2_save);
@@ -971,7 +983,8 @@ static int
 	}
 
     next:
-      f1 = f1->next;
+      if (f1 != NULL)
+	f1 = f1->next;
       if (f2 != NULL)
 	f2 = f2->next;
     }
@@ -1129,12 +1142,14 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_s
    We return nonzero if there exists an actual argument list that
    would be ambiguous between the two interfaces, zero otherwise.
    'strict_flag' specifies whether all the characteristics are
-   required to match, which is not the case for ambiguity checks.*/
+   required to match, which is not the case for ambiguity checks.
+   'p1' and 'p2' are the PASS arguments of both procedures (if applicable).  */
 
 int
 gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
 			int generic_flag, int strict_flag,
-			char *errmsg, int err_len)
+			char *errmsg, int err_len,
+			const char *p1, const char *p2)
 {
   gfc_formal_arglist *f1, *f2;
 
@@ -1200,9 +1215,11 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol
 
   if (generic_flag)
     {
-      if (count_types_test (f1, f2) || count_types_test (f2, f1))
+      if (count_types_test (f1, f2, p1, p2)
+	  || count_types_test (f2, f1, p2, p1))
 	return 0;
-      if (generic_correspondence (f1, f2) || generic_correspondence (f2, f1))
+      if (generic_correspondence (f1, f2, p1, p2)
+	  || generic_correspondence (f2, f1, p2, p1))
 	return 0;
     }
   else
@@ -1349,7 +1366,7 @@ check_interface1 (gfc_interface *p, gfc_interface
 	if (p->sym->attr.flavor != FL_DERIVED
 	    && q->sym->attr.flavor != FL_DERIVED
 	    && gfc_compare_interfaces (p->sym, q->sym, q->sym->name,
-				       generic_flag, 0, NULL, 0))
+				       generic_flag, 0, NULL, 0, NULL, NULL))
 	  {
 	    if (referenced)
 	      gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
@@ -1676,7 +1693,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
 	}
 
       if (!gfc_compare_interfaces (formal, act_sym, act_sym->name, 0, 1, err,
-				   sizeof(err)))
+				   sizeof(err), NULL, NULL))
 	{
 	  if (where)
 	    gfc_error ("Interface mismatch in dummy procedure '%s' at %L: %s",
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 188819)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2842,7 +2842,7 @@ void gfc_free_interface (gfc_interface *);
 int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
 int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
-			    char *, int);
+			    char *, int, const char *, const char *);
 void gfc_check_interfaces (gfc_namespace *);
 void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
 void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 188819)
+++ gcc/fortran/expr.c	(working copy)
@@ -3498,7 +3498,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
 	}
 
       if (s1 && s2 && !gfc_compare_interfaces (s1, s2, name, 0, 1,
-					       err, sizeof(err)))
+					       err, sizeof(err), NULL, NULL))
 	{
 	  gfc_error ("Interface mismatch in procedure pointer assignment "
 		     "at %L: %s", &rvalue->where, err);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 188819)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1152,7 +1152,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	    }
 
 	  if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1,
-					     err, sizeof (err)))
+					     err, sizeof (err), NULL, NULL))
 	    {
 	      gfc_error ("Interface mismatch for procedure-pointer component "
 			 "'%s' in structure constructor at %L: %s",
@@ -11020,8 +11020,8 @@ static gfc_try
 check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2,
 			     const char* generic_name, locus where)
 {
-  gfc_symbol* sym1;
-  gfc_symbol* sym2;
+  gfc_symbol *sym1, *sym2;
+  const char *pass1, *pass2;
 
   gcc_assert (t1->specific && t2->specific);
   gcc_assert (!t1->specific->is_generic);
@@ -11045,8 +11045,20 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1,
     }
 
   /* Compare the interfaces.  */
+  if (t1->specific->nopass)
+    pass1 = NULL;
+  else if (t1->specific->pass_arg)
+    pass1 = t1->specific->pass_arg;
+  else
+    pass1 = t1->specific->u.specific->n.sym->formal->sym->name;
+  if (t2->specific->nopass)
+    pass2 = NULL;
+  else if (t2->specific->pass_arg)
+    pass2 = t2->specific->pass_arg;
+  else
+    pass2 = t2->specific->u.specific->n.sym->formal->sym->name;  
   if (gfc_compare_interfaces (sym1, sym2, sym2->name, !t1->is_operator, 0,
-			      NULL, 0))
+			      NULL, 0, pass1, pass2))
     {
       gfc_error ("'%s' and '%s' for GENERIC '%s' at %L are ambiguous",
 		 sym1->name, sym2->name, generic_name, &where);