1 files changed, 18 insertions, 7 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 759c15adaec..a147449bf70 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -427,15 +427,22 @@ less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2,
 /* Make sure two expressions have the same type.  */
 
 static bool
-same_type_check (gfc_expr *e, int n, gfc_expr *f, int m)
+same_type_check (gfc_expr *e, int n, gfc_expr *f, int m, bool assoc = false)
 {
   gfc_typespec *ets = &e->ts;
   gfc_typespec *fts = &f->ts;
 
-  if (e->ts.type == BT_PROCEDURE && e->symtree->n.sym)
-    ets = &e->symtree->n.sym->ts;
-  if (f->ts.type == BT_PROCEDURE && f->symtree->n.sym)
-    fts = &f->symtree->n.sym->ts;
+  if (assoc)
+    {
+      /* Procedure pointer component expressions have the type of the interface
+	 procedure. If they are being tested for association with a procedure
+	 pointer (ie. not a component), the type of the procedure must be
+	 determined.  */
+      if (e->ts.type == BT_PROCEDURE && e->symtree->n.sym)
+	ets = &e->symtree->n.sym->ts;
+      if (f->ts.type == BT_PROCEDURE && f->symtree->n.sym)
+	fts = &f->symtree->n.sym->ts;
+    }
 
   if (gfc_compare_types (ets, fts))
     return true;
@@ -1002,7 +1009,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
     }
 
   t = true;
-  if (!same_type_check (pointer, 0, target, 1))
+  if (!same_type_check (pointer, 0, target, 1, true))
     t = false;
   if (!rank_check (target, 0, pointer->rank))
     t = false;
@@ -3179,7 +3186,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
 bool
 gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
 {
-  gfc_expr *a, *m, *d;
+  gfc_expr *a, *m, *d, *k;
 
   a = ap->expr;
   if (!int_or_real_check (a, 0) || !array_check (a, 0))
@@ -3187,6 +3194,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
 
   d = ap->next->expr;
   m = ap->next->next->expr;
+  k = ap->next->next->next->expr;
 
   if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
       && ap->next->name == NULL)
@@ -3214,6 +3222,9 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
 				 gfc_current_intrinsic))
     return false;
 
+  if (!kind_check (k, 1, BT_INTEGER))
+    return false;
+
   return true;
 }