re PR fortran/64952 (Missing temporary in assignment from elemental function)

2015-03-23  Paul Thomas  <pault@gcc.gnu.org>
	    Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/64952
fortran/
	* gfortran.h (struct symbol_attribute) : New field
	'array_outer_dependency'.
	* trans.h (struct gfc_ss_info): New field 'array_outer_dependency'.
	* module.c (enum ab_attribute): New value AB_ARRAY_OUTER_DEPENDENCY.
	(attr_bits): Append same value to initializer.
	(mio_symbol_attribute): Handle 'array_outer_dependency' attr
	in module read and write.
	* resolve.c (update_current_proc_outer_array_dependency): New function.
	(resolve_function, resolve_call): Add code to update current procedure's
	'array_outer_dependency' attribute.
	(resolve_variable): Mark current procedure with attribute
	array_outer_dependency if the variable is an array coming from outside
	the current namespace.
	(resolve_fl_procedure): Mark a procedure without body with attribute
	'array_outer_dependency'.
	* trans-array.c (gfc_conv_resolve_dependencies): If any ss is
	marked as 'array_outer_dependency' generate a temporary.
	(gfc_walk_function_expr): If the function may reference external arrays,
	mark the head gfc_ss with flag 'array_outer_dependency'.
testsuite/
	* gfortran.dg/elemental_dependency_4.f90: New.
	* gfortran.dg/elemental_dependency_5.f90: New.


Co-Authored-By: Mikael Morin <mikael@gcc.gnu.org>

From-SVN: r221586

1 files changed, 55 insertions, 0 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 465cf2b..2a24dfd 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;
 }