[Patch, fortran] PR24557 - character(*) dummy used in result specification expression

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This patch fixes PR24557.f90, in which the enclosed testcase ICE-ed 
because the formal argument is used to determine the memory to be 
allocated to the temporary.  Since the formal argument uses the hidden 
character length argument, it is not best used in the main program!  The 
fix uses the actual argument instead, since its character length is 
available to the caller.

The code in the IO call, up to the call to fun (), is shown below. It 
may be seen that parm.9 is the descriptor used to pass the actual 
argument to the assumed shape dummy and that D.830 references it.  
Presently, D.830 is used to build a temporary that is cast to 
(char[0:][1:_arg] *) and used totry to determine size of the temporary 
result.  The [1:_arg] is what breaks things because it is used in the 
wrong scope.  The patch, instead, passes D.830 directly to SIZE0.

Regtested on Cygwin_NT/Athlon-M and FC3/Athlon.  OK for trunk and 4.1?

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

   PR fortran/25964
   * 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-07  Paul Thomas  <pault@gcc.gnu.org>

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


Paul

Code before patch and effect of the patch.

   _gfortran_st_write (&dt_parm.8);
   {
     void * D.840;
     int4 D.839;
     struct array1_int4 atmp.12;
     int4 D.837;
     int4 D.836;
     int4 D.835;
     struct array1_unknown parm.11;
     int4 D.833;
     int4 D.832;
     char[0:][1:_arg] * ifm.10;
     struct array1_unknown * D.830;
     struct array1_unknown parm.9;

     parm.9.dtype = 305;
     parm.9.dim[0].lbound = 1;
     parm.9.dim[0].ubound = 2;
     parm.9.dim[0].stride = 1;
     parm.9.data = (void *) (char[0:][1:4] *) &a[0];
     parm.9.offset = 0;
     D.830 = &parm.9;
_____________patch cuts from here_________________

     ifm.10 = (char[0:][1:_arg] *) (char[0:][1:4] *) D.830->data;
     D.832 = D.830->dim[0].ubound - D.830->dim[0].lbound + 1;
     D.833 = -D.830->dim[0].stride;
     parm.11.dtype = ((<unnamed type>) _arg << 6) + 49;
     D.835 = D.830->dim[0].stride;
     parm.11.dim[0].lbound = 1;
     parm.11.dim[0].ubound = D.832;
     parm.11.dim[0].stride = NON_LVALUE_EXPR <D.835>;
     parm.11.data = (void *) (char[0:][1:_arg] *) &(*ifm.10)[0];
     parm.11.offset = 0;
___________________to here________________________
&parm.11 in next line is replaced with D.830
__________________________________________________
     D.836 = _gfortran_size0 (&parm.11);
     D.837 = D.836 - 1;
     atmp.12.dtype = 265;
     atmp.12.dim[0].stride = 1;
     atmp.12.dim[0].lbound = 0;
     atmp.12.dim[0].ubound = NON_LVALUE_EXPR <D.837>;
     D.839 = NON_LVALUE_EXPR <D.837> + 1;
     D.840 = _gfortran_internal_malloc (D.839 * 4);
     atmp.12.data = D.840;
     atmp.12.offset = 0;
     atmp.12.dim[0].stride = 0;
     fun (&atmp.12, D.830, 4);

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(révision 110298)
+++ gcc/fortran/trans-expr.c	(copie de travail)
@@ -1345,6 +1345,10 @@
   /* 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.  */
Index: gcc/testsuite/gfortran.dg/assumed_charlen_needed_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/assumed_charlen_needed_1.f90	(révision 0)
+++ gcc/testsuite/gfortran.dg/assumed_charlen_needed_1.f90	(révision 0)
@@ -0,0 +1,15 @@
+! { 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