re PR fortran/24557 (ICE: PRINTing function result of size depending on assumed…

re PR fortran/24557 (ICE: PRINTing function result of size depending on assumed length CHARACTER dummy)

2005-02-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/24557
	* trans-expr.c (gfc_add_interface_mapping): Use the actual argument
	for character(*) arrays, rather than casting to the type and kind
	parameters of the formal argument.

2005-02-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/24557
        * gfortran.dg/assumed_charlen_needed_1.f90: New test.

From-SVN: r111130

gcc/fortran/ChangeLog

+2005-02-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24557
+	* trans-expr.c (gfc_add_interface_mapping): Use the actual argument
+	for character(*) arrays, rather than casting to the type and kind
+	parameters of the formal argument.
+
 2006-02-15  Toon Moene  <toon@moene.indiv.nluug.nl>
 
 	PR fortran/26054

gcc/fortran/trans-expr.c

@@ -1346,6 +1346,10 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping,
   /* If the argument is a scalar or a pointer to an array, dereference it.  */
   else if (!sym->attr.dimension || sym->attr.pointer)
     value = build_fold_indirect_ref (se->expr);
+  
+  /* For character(*), use the actual argument's descriptor.  */  
+  else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.cl->length)
+    value = build_fold_indirect_ref (se->expr);
 
   /* If the argument is an array descriptor, use it to determine
      information about the actual argument's shape.  */

gcc/testsuite/ChangeLog

+2005-02-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24557
+        * gfortran.dg/assumed_charlen_needed_1.f90: New test.
+
 2006-02-15  Toon Moene  <toon@moene.indiv.nluug.nl>
 
 	PR fortran/26054

gcc/testsuite/gfortran.dg/assumed_charlen_needed_1.f90

+! { dg-do compile }
+! Tests the fix for PR24557 in which the return of a
+! temporary character(*) array would cause an ICE.
+!
+! Test case provided by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!
+  character(4) :: a(2)
+  print *, fun (a)
+contains
+  function fun (arg)
+    character (*) :: arg (10)
+    integer :: fun(size(arg))
+    fun = 1
+  end function fun
+end