Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 188334)
+++ 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 in the Fortran 95 standard.  */
 
 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,16 @@ 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[i].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 +900,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 (arg[i].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,8 +925,8 @@ 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
+/* 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.
 
    This test is also not symmetric in f1 and f2 and must be called
@@ -942,7 +946,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 +959,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 +972,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 +981,8 @@ static int
 	}
 
     next:
-      f1 = f1->next;
+      if (f1 != NULL)
+	f1 = f1->next;
       if (f2 != NULL)
 	f2 = f2->next;
     }
@@ -1129,12 +1140,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 +1213,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 +1364,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 +1691,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 188334)
+++ 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 188334)
+++ 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 188335)
+++ 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",
@@ -11021,8 +11021,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);
@@ -11046,8 +11046,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);