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

3 files changed, 61 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 51178f2..af15594 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+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.
+
 2005-10-22  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/24426
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);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7c6b409..fe5e24b 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2591,6 +2591,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 {
   gfc_se se;
   gfc_ss *ss;
+  gfc_ref * ref;
+  bool seen_array_ref;
 
   /* The caller has already checked rank>0 and expr_type == EXPR_FUNCTION.  */
   if (expr2->value.function.isym && !gfc_is_intrinsic_libcall (expr2))
@@ -2605,6 +2607,20 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
   if (gfc_ref_needs_temporary_p (expr1->ref))
     return NULL;
 
+  /* Check that no LHS component references appear during an array
+     reference. This is needed because we do not have the means to
+     span any arbitrary stride with an array descriptor. This check
+     is not needed for the rhs because the function result has to be
+     a complete type.  */
+  seen_array_ref = false;
+  for (ref = expr1->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_ARRAY)
+	seen_array_ref= true;
+      else if (ref->type == REF_COMPONENT && seen_array_ref)
+	return NULL;
+    }
+
   /* Check for a dependency.  */
   if (gfc_check_fncall_dependency (expr1, expr2))
     return NULL;