re PR fortran/25746 (Elemental assignment gives wrong result)

2006-05-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25746
	* interface.c (gfc_extend_assign): Use new code EXEC_ASSIGN_CALL.
	* gfortran.h : Put EXEC_ASSIGN_CALL in enum.
	* trans-stmt.c (gfc_conv_elemental_dependencies): New function.
	(gfc_trans_call): Call it.  Add new boolian argument to flag
	need for dependency checking. Assert intent OUT and IN for arg1
	and arg2.
	(gfc_trans_forall_1): Use new code EXEC_ASSIGN_CALL.
	trans-stmt.h : Modify prototype of gfc_trans_call.
	trans.c (gfc_trans_code): Add call for EXEC_ASSIGN_CALL.
	st.c (gfc_free_statement): Free actual for EXEC_ASSIGN_CALL.
	* dependency.c (gfc_check_fncall_dependency): Don't check other
	against itself.

	PR fortran/25090
	* resolve.c : Remove resolving_index_expr.
	(entry_parameter): Remove.
	(gfc_resolve_expr, resolve_charlen, resolve_fl_variable): Remove
	calls to entry_parameter and references to resolving_index_expr.

	PR fortran/27584
	* check.c (gfc_check_associated): Replace NULL assert with an
	error message, since it is possible to generate bad code that
	has us fall through to here..

	PR fortran/19015
	* iresolve.c (maxloc, minloc): If DIM is not present, pass the
	rank of ARRAY as the shape of the result.  Otherwise, pass the
	shape of ARRAY, less the dimension DIM.
	(maxval, minval): The same, when DIM is present, otherwise no
	change.

2006-05-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25746
	* gfortran.dg/elemental_subroutine_3.f90: New test.

	PR fortran/25090
	* gfortran.dg/entry_dummy_ref_1.f90: Remove.

	PR fortran/27584
	* gfortran.dg/associated_target_1.f90: New test.

	PR fortran/19015
	* gfortran.dg/maxloc_shape_1.f90: New test.

From-SVN: r113949

11 files changed, 255 insertions, 78 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4643f40..7e98c46 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,37 @@
+2006-05-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25746
+	* interface.c (gfc_extend_assign): Use new EXEC_ASSIGN_CALL.
+	* gfortran.h : Put EXEC_ASSIGN_CALL in enum.
+	* trans-stmt.c (gfc_conv_elemental_dependencies): New function.
+	(gfc_trans_call): Call it.  Add new boolian argument to flag
+	need for dependency checking. Assert intent OUT and IN for arg1
+	and arg2.
+	(gfc_trans_forall_1): Use new code EXEC_ASSIGN_CALL.
+	trans-stmt.h : Modify prototype of gfc_trans_call.
+	trans.c (gfc_trans_code): Add call for EXEC_ASSIGN_CALL.
+	st.c (gfc_free_statement): Free actual for EXEC_ASSIGN_CALL.
+	* dependency.c (gfc_check_fncall_dependency): Don't check other
+	against itself.
+
+	PR fortran/25090
+	* resolve.c : Remove resolving_index_expr.
+	(entry_parameter): Remove.
+	(gfc_resolve_expr, resolve_charlen, resolve_fl_variable): Lift
+	calls to entry_parameter and references to resolving_index_expr.
+
+	PR fortran/27584
+	* check.c (gfc_check_associated): Replace NULL assert with an
+	error message, since it is possible to generate bad code that
+	has us fall through to here..
+
+	PR fortran/19015
+	* iresolve.c (maxloc, minloc): If DIM is not present, pass the
+	rank of ARRAY as the shape of the result.  Otherwise, pass the
+	shape of ARRAY, less the dimension DIM.
+	(maxval, minval): The same, when DIM is present, otherwise no
+	change.
+
 2006-05-19  H.J. Lu  <hongjiu.lu@intel.com>
 
 	PR fortran/27662
@@ -64,7 +98,7 @@
 	* resolve.c (resolve_code): Add error condition that the return
 	expression must be scalar.
 
-	PR fortran/24711
+	PR fortran/27411
 	* matchexp.c (gfc_get_parentheses): New function.
 	(match_primary): Remove inline code and call above.
 	* gfortran.h: Provide prototype for gfc_get_parentheses.
@@ -244,7 +278,7 @@
 	result, is also automatic character length.  If so, process
 	the character length.
 
-	PR fortran/18803
+	PR fortran/18003
 	PR fortran/25669
 	PR fortran/26834
 	* trans_intrinsic.c (gfc_walk_intrinsic_bound): Set
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index a24333c..947bcdc 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -532,7 +532,12 @@ gfc_check_associated (gfc_expr * pointer, gfc_expr * target)
   else if (target->expr_type == EXPR_FUNCTION)
     attr = target->symtree->n.sym->attr;
   else
-    gcc_assert (0); /* Target must be a variable or a function.  */
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer "
+		 "or target VARIABLE or FUNCTION", gfc_current_intrinsic_arg[1],
+		 gfc_current_intrinsic, &target->where);
+      return FAILURE;
+    }
 
   if (!attr.pointer && !attr.target)
     {
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 4634c1f..28c6498 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -513,6 +513,10 @@ gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
       if (!expr)
 	continue;
 
+      /* Skip other itself.  */
+      if (expr == other)
+	continue;
+
       /* Skip intent(in) arguments if OTHER itself is intent(in).  */
       if (formal
 	  && intent == INTENT_IN
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b1b6817..d5b3411 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1487,7 +1487,7 @@ gfc_forall_iterator;
 typedef enum
 {
   EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN,
-  EXEC_GOTO, EXEC_CALL, EXEC_RETURN, EXEC_ENTRY,
+  EXEC_GOTO, EXEC_CALL, EXEC_ASSIGN_CALL, EXEC_RETURN, EXEC_ENTRY,
   EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE,
   EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
   EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 060da05..74f7669 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1827,7 +1827,7 @@ gfc_extend_assign (gfc_code * c, gfc_namespace * ns)
     }
 
   /* Replace the assignment with the call.  */
-  c->op = EXEC_CALL;
+  c->op = EXEC_ASSIGN_CALL;
   c->symtree = find_sym_in_symtree (sym);
   c->expr = NULL;
   c->expr2 = NULL;
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ecb1448..3cf84db 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1081,16 +1081,32 @@ gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
   const char *name;
+  int i, j, idim;
 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)
-    f->rank = 1;
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_si (f->shape[0], array->rank);
+    }
   else
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
+      if (array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+	        j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
     }
 
   if (mask)
@@ -1125,6 +1141,7 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
   const char *name;
+  int i, j, idim;
 
   f->ts = array->ts;
 
@@ -1132,6 +1149,18 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
+
+      if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+	        j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
     }
 
   if (mask)
@@ -1188,16 +1217,32 @@ gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
   const char *name;
+  int i, j, idim;
 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)
-    f->rank = 1;
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_si (f->shape[0], array->rank);
+    }
   else
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
+      if (array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+	        j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
     }
 
   if (mask)
@@ -1232,6 +1277,7 @@ gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
   const char *name;
+  int i, j, idim;
 
   f->ts = array->ts;
 
@@ -1239,6 +1285,18 @@ gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
+
+      if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+	        j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
     }
 
   if (mask)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f106d05..0affecc 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -60,9 +60,6 @@ static int omp_workshare_flag;
    resets the flag each time that it is read.  */
 static int formal_arg_flag = 0;
 
-/* True if we are resolving a specification expression.  */
-static int resolving_index_expr = 0;
-
 int
 gfc_is_formal_arg (void)
 {
@@ -2683,43 +2680,6 @@ resolve_variable (gfc_expr * e)
 }
 
 
-/* Emits an error if the expression is a variable that is not a parameter
-   in all entry formal argument lists for the namespace.  */
-
-static void
-entry_parameter (gfc_expr *e)
-{
-  gfc_symbol *sym, *esym;
-  gfc_entry_list *entry;
-  gfc_formal_arglist *f;
-  bool p;
-
-
-  sym = e->symtree->n.sym;
-
-  if (sym->attr.use_assoc
-	|| !sym->attr.dummy
-	|| sym->ns != gfc_current_ns)
-    return;
-
-  entry = sym->ns->entries;
-  for (; entry; entry = entry->next)
-    {
-      esym = entry->sym;
-      p = false;
-      for (f = esym->formal; f && !p; f = f->next)
-	{
-	  if (f->sym && f->sym->name && sym->name == f->sym->name)
-	    p = true;
-	}
-      if (!p)
-	gfc_error ("%s at %L must be a parameter of the entry at %L",
-		   sym->name, &e->where, &esym->declared_at);
-    }
-  return;
-}
-
-
 /* Resolve an expression.  That is, make sure that types of operands agree
    with their operators, intrinsic operators are converted to function calls
    for overloaded types and unresolved function references are resolved.  */
@@ -2744,10 +2704,6 @@ gfc_resolve_expr (gfc_expr * e)
 
     case EXPR_VARIABLE:
       t = resolve_variable (e);
-
-      if (gfc_current_ns->entries && resolving_index_expr)
-	entry_parameter (e);
-
       if (t == SUCCESS)
 	expression_rank (e);
       break;
@@ -4699,6 +4655,7 @@ resolve_values (gfc_symbol * sym)
 static try
 resolve_index_expr (gfc_expr * e)
 {
+
   if (gfc_resolve_expr (e) == FAILURE)
     return FAILURE;
 
@@ -4721,12 +4678,9 @@ resolve_charlen (gfc_charlen *cl)
 
   cl->resolved = 1;
 
-  resolving_index_expr = 1;
-
   if (resolve_index_expr (cl->length) == FAILURE)
     return FAILURE;
 
-  resolving_index_expr = 0;
   return SUCCESS;
 }
 
@@ -4813,29 +4767,20 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
   if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
     return FAILURE;
 
-  /* Set this flag to check that variables are parameters of all entries.
-     This check is effected by the call to gfc_resolve_expr through
-     is_non_contant_shape_array.  */
-  resolving_index_expr = 1;
-
-  if (!sym->attr.use_assoc
+  /* The shape of a main program or module array needs to be constant.  */
+  if (sym->ns->proc_name
+	&& (sym->ns->proc_name->attr.flavor == FL_MODULE
+	     || sym->ns->proc_name->attr.is_main_program)
+	&& !sym->attr.use_assoc
 	&& !sym->attr.allocatable
 	&& !sym->attr.pointer
 	&& is_non_constant_shape_array (sym))
     {
-	/* The shape of a main program or module array needs to be constant.  */
-	if (sym->ns->proc_name
-	      && (sym->ns->proc_name->attr.flavor == FL_MODULE
-		    || sym->ns->proc_name->attr.is_main_program))
-	  {
-	    gfc_error ("The module or main program array '%s' at %L must "
-		       "have constant shape", sym->name, &sym->declared_at);
-	    return FAILURE;
-	  }
+       gfc_error ("The module or main program array '%s' at %L must "
+		     "have constant shape", sym->name, &sym->declared_at);
+	  return FAILURE;
     }
 
-  resolving_index_expr = 0;
-
   if (sym->ts.type == BT_CHARACTER)
     {
       /* Make sure that character string variables with assumed length are
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index e7461a7..cc86687 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -112,6 +112,7 @@ gfc_free_statement (gfc_code * p)
       break;
 
     case EXEC_CALL:
+    case EXEC_ASSIGN_CALL:
       gfc_free_actual_arglist (p->ext.actual);
       break;
 
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6480a19..ab7d5a5 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -199,10 +199,121 @@ gfc_trans_entry (gfc_code * code)
 }
 
 
+/* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of
+   elemental subroutines.  Make temporaries for output arguments if any such
+   dependencies are found.  Output arguments are chosen because internal_unpack
+   can be used, as is, to copy the result back to the variable.  */
+static void
+gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
+				 gfc_symbol * sym, gfc_actual_arglist * arg)
+{
+  gfc_actual_arglist *arg0;
+  gfc_expr *e;
+  gfc_formal_arglist *formal;
+  gfc_loopinfo tmp_loop;
+  gfc_se parmse;
+  gfc_ss *ss;
+  gfc_ss_info *info;
+  gfc_symbol *fsym;
+  int n;
+  stmtblock_t block;
+  tree data;
+  tree offset;
+  tree size;
+  tree tmp;
+
+  if (loopse->ss == NULL)
+    return;
+
+  ss = loopse->ss;
+  arg0 = arg;
+  formal = sym->formal;
+
+  /* Loop over all the arguments testing for dependencies.  */
+  for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
+    {
+      e = arg->expr;
+      if (e == NULL)
+	continue;
+
+      /* Obtain the info structure for the current argument.  */ 
+      info = NULL;
+      for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
+	{
+	  if (ss->expr != e)
+	    continue;
+	  info = &ss->data.info;
+	  break;
+	}
+
+      /* If there is a dependency, create a temporary and use it
+	 instead of the variable. */
+      fsym = formal ? formal->sym : NULL;
+      if (e->expr_type == EXPR_VARIABLE
+	    && e->rank && fsym
+	    && fsym->attr.intent == INTENT_OUT
+	    && gfc_check_fncall_dependency (e, INTENT_OUT, sym, arg0))
+	{
+	  /* Make a local loopinfo for the temporary creation, so that
+	     none of the other ss->info's have to be renormalized.  */
+	  gfc_init_loopinfo (&tmp_loop);
+	  for (n = 0; n < info->dimen; n++)
+	    {
+	      tmp_loop.to[n] = loopse->loop->to[n];
+	      tmp_loop.from[n] = loopse->loop->from[n];
+	      tmp_loop.order[n] = loopse->loop->order[n];
+	    }
+
+	  /* Generate the temporary.  Merge the block so that the
+	     declarations are put at the right binding level.  */
+	  size = gfc_create_var (gfc_array_index_type, NULL);
+	  data = gfc_create_var (pvoid_type_node, NULL);
+	  gfc_start_block (&block);
+	  tmp = gfc_typenode_for_spec (&e->ts);
+	  tmp = gfc_trans_create_temp_array (&se->pre, &se->post,
+					      &tmp_loop, info, tmp,
+					      false, true, false);
+	  gfc_add_modify_expr (&se->pre, size, tmp);
+	  tmp = fold_convert (pvoid_type_node, info->data);
+	  gfc_add_modify_expr (&se->pre, data, tmp);
+	  gfc_merge_block_scope (&block);
+
+	  /* Obtain the argument descriptor for unpacking.  */
+	  gfc_init_se (&parmse, NULL);
+	  parmse.want_pointer = 1;
+	  gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
+	  gfc_add_block_to_block (&se->pre, &parmse.pre);
+
+	  /* Calculate the offset for the temporary.  */
+	  offset = gfc_index_zero_node;
+	  for (n = 0; n < info->dimen; n++)
+	    {
+	      tmp = gfc_conv_descriptor_stride (info->descriptor,
+						gfc_rank_cst[n]);
+	      tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+				 loopse->loop->from[n], tmp);
+	      offset = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+					  offset, tmp);
+	    }
+	  info->offset = gfc_create_var (gfc_array_index_type, NULL);	  
+	  gfc_add_modify_expr (&se->pre, info->offset, offset);
+
+	  /* Copy the result back using unpack.  */
+	  tmp = gfc_chainon_list (NULL_TREE, parmse.expr);
+	  tmp = gfc_chainon_list (tmp, data);
+	  tmp = build_function_call_expr (gfor_fndecl_in_unpack, tmp);
+	  gfc_add_expr_to_block (&se->post, tmp);
+
+	  gfc_add_block_to_block (&se->post, &parmse.post);
+	}
+    }
+}
+
+
 /* Translate the CALL statement.  Builds a call to an F95 subroutine.  */
 
 tree
-gfc_trans_call (gfc_code * code)
+gfc_trans_call (gfc_code * code, bool dependency_check)
 {
   gfc_se se;
   gfc_ss * ss;
@@ -269,11 +380,25 @@ gfc_trans_call (gfc_code * code)
       gfc_conv_loop_setup (&loop);
       gfc_mark_ss_chain_used (ss, 1);
 
+      /* Convert the arguments, checking for dependencies.  */
+      gfc_copy_loopinfo_to_se (&loopse, &loop);
+      loopse.ss = ss;
+
+      /* For operator assignment, we need to do dependency checking.  
+	 We also check the intent of the parameters.  */
+      if (dependency_check)
+	{
+	  gfc_symbol *sym;
+	  sym = code->resolved_sym;
+	  gcc_assert (sym->formal->sym->attr.intent = INTENT_OUT);
+	  gcc_assert (sym->formal->next->sym->attr.intent = INTENT_IN);
+	  gfc_conv_elemental_dependencies (&se, &loopse, sym,
+					   code->ext.actual);
+	}
+
       /* Generate the loop body.  */
       gfc_start_scalarized_body (&loop, &body);
       gfc_init_block (&block);
-      gfc_copy_loopinfo_to_se (&loopse, &loop);
-      loopse.ss = ss;
 
       /* Add the subroutine call to the block.  */
       gfc_conv_function_call (&loopse, code->resolved_sym, code->ext.actual);
@@ -287,6 +412,7 @@ gfc_trans_call (gfc_code * code)
       gfc_trans_scalarizing_loops (&loop, &body);
       gfc_add_block_to_block (&se.pre, &loop.pre);
       gfc_add_block_to_block (&se.pre, &loop.post);
+      gfc_add_block_to_block (&se.pre, &se.post);
       gfc_cleanup_loop (&loop);
     }
 
@@ -2539,8 +2665,8 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
 
 	/* Explicit subroutine calls are prevented by the frontend but interface
 	   assignments can legitimately produce them.  */
-	case EXEC_CALL:
-	  assign = gfc_trans_call (c);
+	case EXEC_ASSIGN_CALL:
+	  assign = gfc_trans_call (c, true);
           tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1, 1);
           gfc_add_expr_to_block (&block, tmp);
           break;
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index a71c8bf..e30cb23 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -38,7 +38,7 @@ tree gfc_trans_goto (gfc_code *);
 tree gfc_trans_entry (gfc_code *);
 tree gfc_trans_pause (gfc_code *);
 tree gfc_trans_stop (gfc_code *);
-tree gfc_trans_call (gfc_code *);
+tree gfc_trans_call (gfc_code *, bool);
 tree gfc_trans_return (gfc_code *);
 tree gfc_trans_if (gfc_code *);
 tree gfc_trans_arithmetic_if (gfc_code *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 3a15d8b..3eec75c 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -494,7 +494,11 @@ gfc_trans_code (gfc_code * code)
 	  break;
 
 	case EXEC_CALL:
-	  res = gfc_trans_call (code);
+	  res = gfc_trans_call (code, false);
+	  break;
+
+	case EXEC_ASSIGN_CALL:
+	  res = gfc_trans_call (code, true);
 	  break;
 
 	case EXEC_RETURN: