1 files changed, 60 insertions, 0 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 465cf2ba8cf..316b413d756 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2866,6 +2866,32 @@ static bool check_pure_function (gfc_expr *e)
 }
 
 
+/* Update current procedure's array_outer_dependency flag, considering
+   a call to procedure SYM.  */
+
+static void
+update_current_proc_array_outer_dependency (gfc_symbol *sym)
+{
+  /* Check to see if this is a sibling function that has not yet
+     been resolved.  */
+  gfc_namespace *sibling = gfc_current_ns->sibling;
+  for (; sibling; sibling = sibling->sibling)
+    {
+      if (sibling->proc_name == sym)
+	{
+	  gfc_resolve (sibling);
+	  break;
+	}
+    }
+
+  /* If SYM has references to outer arrays, so has the procedure calling
+     SYM.  If SYM is a procedure pointer, we can assume the worst.  */
+  if (sym->attr.array_outer_dependency
+      || sym->attr.proc_pointer)
+    gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+}
+
+
 /* Resolve a function call, which means resolving the arguments, then figuring
    out which entity the name refers to.  */
 
@@ -3090,6 +3116,17 @@ resolve_function (gfc_expr *expr)
 	expr->ts = expr->symtree->n.sym->result->ts;
     }
 
+  if (!expr->ref && !expr->value.function.isym)
+    {
+      if (expr->value.function.esym)
+	update_current_proc_array_outer_dependency (expr->value.function.esym);
+      else
+	update_current_proc_array_outer_dependency (sym);
+    }
+  else if (expr->ref)
+    /* typebound procedure: Assume the worst.  */
+    gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+
   return t;
 }
 
@@ -3427,6 +3464,12 @@ resolve_call (gfc_code *c)
   if (!resolve_elemental_actual (NULL, c))
     return false;
 
+  if (!c->expr1)
+    update_current_proc_array_outer_dependency (csym);
+  else
+    /* Typebound procedure: Assume the worst.  */
+    gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+
   return t;
 }
 
@@ -5058,6 +5101,13 @@ resolve_variable (gfc_expr *e)
 		    && gfc_current_ns->parent->parent == sym->ns)))
     sym->attr.host_assoc = 1;
 
+  if (gfc_current_ns->proc_name
+      && sym->attr.dimension
+      && (sym->ns != gfc_current_ns
+	  || sym->attr.use_assoc
+	  || sym->attr.in_common))
+    gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+
 resolve_procedure:
   if (t && !resolve_procedure_expression (e))
     t = false;
@@ -11494,6 +11544,11 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
 	}
     }
 
+  /* Assume that a procedure whose body is not known has references
+     to external arrays.  */
+  if (sym->attr.if_source != IFSRC_DECL)
+    sym->attr.array_outer_dependency = 1;
+
   return true;
 }
 
@@ -14887,6 +14942,9 @@ resolve_types (gfc_namespace *ns)
   gfc_equiv *eq;
   gfc_namespace* old_ns = gfc_current_ns;
 
+  if (ns->types_resolved)
+    return;
+
   /* Check that all IMPLICIT types are ok.  */
   if (!ns->seen_implicit_none)
     {
@@ -14961,6 +15019,8 @@ resolve_types (gfc_namespace *ns)
 
   gfc_resolve_omp_udrs (ns->omp_udr_root);
 
+  ns->types_resolved = 1;
+
   gfc_current_ns = old_ns;
 }