re PR fortran/31213 (ICE on valid code with gfortran)

2007-12-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31213
	PR fortran/33888
	PR fortran/33998
	* trans-array.c (gfc_trans_array_constructor_value): If the
	iterator variable does not have a backend_decl, use a local
	temporary.
	(get_elemental_fcn_charlen): New function to map the character
	length of an elemental function onto its actual arglist.
	(gfc_conv_expr_descriptor): Call the above so that the size of
	the temporary can be evaluated.
	* trans-expr.c : Include arith.h and change prototype of
	gfc_apply_interface_mapping_to_expr to return void.  Change all
	references to gfc_apply_interface_mapping_to_expr accordingly.
	(gfc_free_interface_mapping): Free the 'expr' field.
	(gfc_add_interface_mapping): Add an argument for the actual
	argument expression. This is copied to the 'expr' field of the
	mapping.  Only stabilize the backend_decl if the se is present.
	Copy the character length expression and only add it's backend
	declaration if se is present.  Return without working on the
	backend declaration for the new symbol if se is not present.
	(gfc_map_intrinsic_function) : To simplify intrinsics 'len',
	'size', 'ubound' and 'lbound' and then to map the result.
	(gfc_map_fcn_formal_to_actual): Performs the formal to actual
	mapping for the case of a function found in a specification
	expression in the interface being mapped.
	(gfc_apply_interface_mapping_to_ref): Remove seen_result and
	all its references. Remove the inline simplification of LEN
	and call gfc_map_intrinsic_function instead.  Change the
	order of mapping of the actual arguments and simplifying
	intrinsic functions.  Finally, if a function maps to an
	actual argument, call gfc_map_fcn_formal_to_actual.
	(gfc_conv_function_call): Add 'e' to the call to
	gfc_add_interface_mapping.
	* dump-parse-tree.c (gfc_show_symbol_n): New function for
	diagnostic purposes.
	* gfortran.h : Add prototype for gfc_show_symbol_n.
	* trans.h : Add 'expr' field to gfc_add_interface_mapping.
	Add 'expr' to prototype for gfc_show_symbol_n.
	* resolve.c (resolve_generic_f0): Set specific function as
	referenced.

2007-12-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31213
	PR fortran/33888
	PR fortran/33998
	* gfortran.dg/mapping_1.f90: New test.
	* gfortran.dg/mapping_2.f90: New test.
	* gfortran.dg/mapping_3.f90: New test.

From-SVN: r130988

1 files changed, 60 insertions, 4 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 17a63d2..2ebb365 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1225,10 +1225,21 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
 
 	  loopbody = gfc_finish_block (&body);
 
-	  gfc_init_se (&se, NULL);
-	  gfc_conv_expr (&se, c->iterator->var);
-	  gfc_add_block_to_block (pblock, &se.pre);
-	  loopvar = se.expr;
+	  if (c->iterator->var->symtree->n.sym->backend_decl)
+	    {
+	      gfc_init_se (&se, NULL);
+	      gfc_conv_expr (&se, c->iterator->var);
+	      gfc_add_block_to_block (pblock, &se.pre);
+	      loopvar = se.expr;
+	    }
+	  else
+	    {
+	      /* If the iterator appears in a specification expression in
+		 an interface mapping, we need to make a temp for the loop
+		 variable because it is not declared locally.  */
+	      loopvar = gfc_typenode_for_spec (&c->iterator->var->ts);
+	      loopvar = gfc_create_var (loopvar, "loopvar");
+	    }
 
 	  /* Make a temporary, store the current value in that
 	     and return it, once the loop is done.  */
@@ -4491,6 +4502,47 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
 }
 
 
+/* gfc_conv_expr_descriptor needs the character length of elemental
+   functions before the function is called so that the size of the
+   temporary can be obtained.  The only way to do this is to convert
+   the expression, mapping onto the actual arguments.  */
+static void
+get_elemental_fcn_charlen (gfc_expr *expr, gfc_se *se)
+{
+  gfc_interface_mapping mapping;
+  gfc_formal_arglist *formal;
+  gfc_actual_arglist *arg;
+  gfc_se tse;
+
+  formal = expr->symtree->n.sym->formal;
+  arg = expr->value.function.actual;
+  gfc_init_interface_mapping (&mapping);
+
+  /* Set se = NULL in the calls to the interface mapping, to supress any
+     backend stuff.  */
+  for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
+    {
+      if (!arg->expr)
+	continue;
+      if (formal->sym)
+	gfc_add_interface_mapping (&mapping, formal->sym, NULL, arg->expr);
+    }
+
+  gfc_init_se (&tse, NULL);
+
+  /* Build the expression for the character length and convert it.  */
+  gfc_apply_interface_mapping (&mapping, &tse, expr->ts.cl->length);
+
+  gfc_add_block_to_block (&se->pre, &tse.pre);
+  gfc_add_block_to_block (&se->post, &tse.post);
+  tse.expr = fold_convert (gfc_charlen_type_node, tse.expr);
+  tse.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tse.expr,
+			  build_int_cst (gfc_charlen_type_node, 0));
+  expr->ts.cl->backend_decl = tse.expr;
+  gfc_free_interface_mapping (&mapping);
+}
+
+
 /* Convert an array for passing as an actual argument.  Expressions and
    vector subscripts are evaluated and stored in a temporary, which is then
    passed.  For whole arrays the descriptor is passed.  For array sections
@@ -4624,6 +4676,10 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	{
 	  /* Elemental function.  */
 	  need_tmp = 1;
+	  if (expr->ts.type == BT_CHARACTER
+		&& expr->ts.cl->length->expr_type != EXPR_CONSTANT)
+	    get_elemental_fcn_charlen (expr, se);
+
 	  info = NULL;
 	}
       else