[Fortran, (RFC) patch] PR49110/51055 Assignment to alloc. deferred-length character vars

[Tobias Burnus <burnus at net-b dot de>]

Dear all,

the following patch fixes

  character(len=:), allocatable :: str
  str = repeat('X', n)

Before the patch, the (re)allocation happened before the RHS was 
evaluated. Thus, the string length wasn't known! (Work around: Add 
parentheses around the function call.)


Note that the patch assumes that the function's result variable's length 
specification expression is completely known to the caller. I think 
that's always the case in gfortran - or is it not?.

I am not sure whether once can construct a valid program using INTERFACE 
where that's not the case. The answer is probably no, given:
"If a type parameter of a function result or a bound of a function 
result array is not a constant expression, the exact dependence on the 
entities in the expression is a characteristic." (F2008, 12.3.3). -- 
Nevertheless, one has to think about whether there could be some issue. 
If there is, I have no idea how one could handle it instead. Thus, there 
be better no issue!


I am also not positive that len=: pointer results are properly handled, 
but probably they are. (Untested; character array results are also 
untested - and array constructors are known to be broken.)

Comments?

The attached patch builds and regtests.
OK for the trunk?

Tobias
2012-05-11  Tobias Burnus  <burnus@net-b.de>

	PR fortran/49110
	PR fortran/51055
	* trans-expr.c (gfc_trans_assignment_1): Fix allocation
	handling for assignment of function results to allocatable
	deferred-length strings.

2012-05-11  Tobias Burnus  <burnus@net-b.de>

	PR fortran/49110
	PR fortran/51055
	* gfortran.dg/deferred_type_param_3.f90: New.
	* gfortran.dg/deferred_type_param_4.f90: New.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 8045b1f..8126697 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7002,17 +7003,18 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
     {
       tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);
       gfc_add_expr_to_block (&loop.post, tmp);
     }
 
-  /* For a deferred character length function, the function call must
-     happen before the (re)allocation of the lhs, otherwise the character
-     length of the result is not known.  */
-  def_clen_func = (((expr2->expr_type == EXPR_FUNCTION)
-			   || (expr2->expr_type == EXPR_COMPCALL)
-			   || (expr2->expr_type == EXPR_PPC))
-		       && expr2->ts.deferred);
+  /* When assigning a character function result to a deferred-length variable,
+     the function call must happen before the (re)allocation of the lhs -
+     otherwise the character length of the result is not known.
+     NOTE: This relies on having the exact dependence of the length type
+     parameter available to the caller; gfortran save it in the .mod files. */
+  def_clen_func = (expr2->expr_type == EXPR_FUNCTION
+		   || expr2->expr_type == EXPR_COMPCALL
+		   || expr2->expr_type == EXPR_PPC);
   if (gfc_option.flag_realloc_lhs
 	&& expr2->ts.type == BT_CHARACTER
 	&& (def_clen_func || expr2->expr_type == EXPR_OP)
 	&& expr1->ts.deferred)
     gfc_add_block_to_block (&block, &rse.pre);
--- /dev/null	2012-05-11 07:40:56.923831265 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_3.f90	2012-05-11 12:18:46.000000000 +0200
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/51055
+! PR fortran/49110
+!
+
+subroutine test()
+  implicit none
+  integer :: i = 5
+  character(len=:), allocatable :: s1
+  call sub(s1, i)
+  if (len(s1) /= 5) call abort()
+  if (s1 /= "ZZZZZ") call abort()
+contains
+  subroutine sub(str,j)
+    character(len=:), allocatable :: str
+    integer :: j
+    str = REPEAT("Z",j)
+    if (len(str) /= 5) call abort()
+    if (str /= "ZZZZZ") call abort()
+  end subroutine sub
+end subroutine test
+
+program a
+ character(len=:),allocatable :: s
+ integer :: j=2
+ s = repeat ('x', j)
+ if (len(repeat(' ',j)) /= 2) call abort()
+ if (repeat('y',j) /= "yy") call abort()
+ if (len(s) /= 2) call abort()
+ if (s /= "xx") call abort()
+ call test()
+end program a
--- /dev/null	2012-05-11 07:40:56.923831265 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_4.f90	2012-05-11 12:22:30.000000000 +0200
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/51055
+! PR fortran/49110
+!
+!
+program test
+  implicit none
+  character(len=:), allocatable :: str
+  integer :: i
+  i = 5
+  str = f()
+  call printIt ()
+  i = 7
+  str = repeat('X', i)
+  call printIt ()
+contains
+  function f()
+    character(len=i) :: f
+    f = '1234567890'
+  end function f
+  subroutine printIt
+!    print *, len(str)
+!    print '(3a)', '>',str,'<'
+    if (i == 5) then
+      if (str /= "12345" .or. len(str) /= 5) call abort ()
+    else if (i == 7) then
+      if (str /= "XXXXXXX" .or. len(str) /= 7) call abort ()
+    else
+      call abort ()
+    end if
+  end subroutine
+end