re PR fortran/18022 (problem with structure and calling a function)

2005-10-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/18022
	* trans-expr.c (gfc_trans_arrayfunc_assign): Return NULL
	if there is a component ref during an array ref to force
	use of temporary in assignment.

	PR fortran/24311
	PR fortran/24384
	* fortran/iresolve.c (check_charlen_present): New function to
	add a charlen to the typespec, in the case of constant
	expressions.
	(gfc_resolve_merge, gfc_resolve_spread): Call.the above.
	(gfc_resolve_spread): Make calls to library functions that
	handle the case of the spread intrinsic with a scalar source.
	* libgfortran/intrinsics/spread_generic.c (spread_internal
	_scalar): New function that handles the special case of spread
	with a scalar source. This has interface functions -
	(spread_scalar, spread_char_scalar): New functions to interface
	with the calls specified in gfc_resolve_spread.

2005-10-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/18022
	gfortran.dg/assign_func_dtcomp_1.f90: New test.

	PR fortran/24311
	gfortran.dg/merge_char_const.f90: New test.

	PR fortran/24384
	gfortran.dg/spread_scalar_source.f90: New test.

From-SVN: r105810

1 files changed, 29 insertions, 3 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 6c23d4a..9cba18b 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -59,6 +59,21 @@ gfc_get_string (const char *format, ...)
   return IDENTIFIER_POINTER (ident);
 }
 
+/* MERGE and SPREAD need to have source charlen's present for passing
+   to the result expression.  */
+static void
+check_charlen_present (gfc_expr *source)
+{
+  if (source->expr_type == EXPR_CONSTANT && source->ts.cl == NULL)
+    {
+      source->ts.cl = gfc_get_charlen ();
+      source->ts.cl->next = gfc_current_ns->cl_list;
+      gfc_current_ns->cl_list = source->ts.cl;
+      source->ts.cl->length = gfc_int_expr (source->value.character.length);
+      source->rank = 0;
+    }
+}
+
 /********************** Resolution functions **********************/
 
 
@@ -996,6 +1011,9 @@ gfc_resolve_merge (gfc_expr * f, gfc_expr * tsource,
 		   gfc_expr * fsource ATTRIBUTE_UNUSED,
 		   gfc_expr * mask ATTRIBUTE_UNUSED)
 {
+  if (tsource->ts.type == BT_CHARACTER)
+    check_charlen_present (tsource);
+
   f->ts = tsource->ts;
   f->value.function.name =
     gfc_get_string ("__merge_%c%d", gfc_type_letter (tsource->ts.type),
@@ -1395,11 +1413,19 @@ gfc_resolve_spread (gfc_expr * f, gfc_expr * source,
 		    gfc_expr * dim,
 		    gfc_expr * ncopies)
 {
+  if (source->ts.type == BT_CHARACTER)
+    check_charlen_present (source);
+
   f->ts = source->ts;
   f->rank = source->rank + 1;
-  f->value.function.name = (source->ts.type == BT_CHARACTER
-			    ? PREFIX("spread_char")
-			    : PREFIX("spread"));
+  if (source->rank == 0)
+    f->value.function.name = (source->ts.type == BT_CHARACTER
+			      ? PREFIX("spread_char_scalar")
+			      : PREFIX("spread_scalar"));
+  else
+    f->value.function.name = (source->ts.type == BT_CHARACTER
+			      ? PREFIX("spread_char")
+			      : PREFIX("spread"));
 
   gfc_resolve_dim_arg (dim);
   gfc_resolve_index (ncopies, 1);