re PR fortran/35681 (wrong result for vector subscripted array expression in MVBITS)

2008-11-01  Daniel Kraft  <d@domob.eu>

	PR fortran/35681
	* gfortran.h (struct gfc_code): New field `resolved_isym'.
	* trans.h (gfc_build_memcpy_call): Made public.
	* trans-array.h (gfc_trans_create_temp_array): New argument `initial'.
	* intrinsic.c (gfc_intrinsic_sub_interface): Set resolved_isym.
	* iresolve.c (create_formal_for_intents): New helper method.
	(gfc_resolve_mvbits): Put dummy formal arglist on resolved_sym.
	* resolve.c (resolve_call): Initialize resolved_isym to NULL.
	* trans-array.c (gfc_trans_allocate_array_storage): New argument
	`initial' to allow initializing the allocated storage to some initial
	value copied from another array.
	(gfc_trans_create_temp_array): Allow initialization of the temporary
	with a copy of some other array by using the new extension.
	(gfc_trans_array_constructor): Pass NULL_TREE for initial argument.
	(gfc_conv_loop_setup): Ditto.
	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Ditto.
	* trans-expr.c (gfc_conv_function_call): Ditto.
	(gfc_build_memcpy_call): Made public.
	* trans-stmt.c (gfc_conv_elemental_dependencies): Initialize created
	temporary for INTENT(INOUT) arguments to the value of the mirrored
	array and clean up the temporary as very last intructions in the created
	block.
	* trans.c (gfc_trans_code): For EXEC_CALL, see if we have a MVBITS call
	and enable elemental dependency checking if we have.

2008-11-01  Daniel Kraft  <d@domob.eu>

	PR fortran/35681
	* gfortran.dg/mvbits_4.f90: New test.

From-SVN: r141516

1 files changed, 31 insertions, 12 deletions

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index da227523e72..343d5359d28 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -251,6 +251,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	    && gfc_check_fncall_dependency (e, fsym->attr.intent,
 					    sym, arg0))
 	{
+	  tree initial;
+	  stmtblock_t temp_post;
+
 	  /* 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);
@@ -261,27 +264,38 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	      tmp_loop.order[n] = loopse->loop->order[n];
 	    }
 
+	  /* 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);
+
+	  /* If we've got INTENT(INOUT), initialize the array temporary with
+	     a copy of the values.  */
+	  if (fsym->attr.intent == INTENT_INOUT)
+	    initial = parmse.expr;
+	  else
+	    initial = NULL_TREE;
+
 	  /* Generate the temporary.  Merge the block so that the
-	     declarations are put at the right binding level.  */
+	     declarations are put at the right binding level.  Cleaning up the
+	     temporary should be the very last thing done, so we add the code to
+	     a new block and add it to se->post as last instructions.  */
 	  size = gfc_create_var (gfc_array_index_type, NULL);
 	  data = gfc_create_var (pvoid_type_node, NULL);
 	  gfc_start_block (&block);
+	  gfc_init_block (&temp_post);
 	  tmp = gfc_typenode_for_spec (&e->ts);
-	  tmp = gfc_trans_create_temp_array (&se->pre, &se->post,
-					      &tmp_loop, info, tmp,
-					      false, true, false,
-					     & arg->expr->where);
+	  tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
+					     &tmp_loop, info, tmp,
+					     initial,
+					     false, true, false,
+					     &arg->expr->where);
 	  gfc_add_modify (&se->pre, size, tmp);
 	  tmp = fold_convert (pvoid_type_node, info->data);
 	  gfc_add_modify (&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++)
@@ -296,11 +310,16 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	  info->offset = gfc_create_var (gfc_array_index_type, NULL);	  
 	  gfc_add_modify (&se->pre, info->offset, offset);
 
+
 	  /* Copy the result back using unpack.  */
 	  tmp = build_call_expr (gfor_fndecl_in_unpack, 2, parmse.expr, data);
 	  gfc_add_expr_to_block (&se->post, tmp);
 
+	  /* XXX: This is possibly not needed; but isn't it cleaner this way? */
+	  gfc_add_block_to_block (&se->pre, &parmse.pre);
+
 	  gfc_add_block_to_block (&se->post, &parmse.post);
+	  gfc_add_block_to_block (&se->post, &temp_post);
 	}
     }
 }
@@ -367,7 +386,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check)
       gfc_se loopse;
 
       /* gfc_walk_elemental_function_args renders the ss chain in the
-         reverse order to the actual argument order.  */
+	 reverse order to the actual argument order.  */
       ss = gfc_reverse_ss (ss);
 
       /* Initialize the loop.  */