re PR fortran/47523 (Concatenation with deferred length character with lhs variable)

2011-01-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/47523
	* trans-expr.c (gfc_trans_assignment_1): If the rhs is an op
	expr and is assigned to a deferred character length scalar,
	make sure that the function is called before reallocation,
	so that the length is available. Include procedure pointer
	and procedure pointer component rhs as well.

2011-01-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/47523
	* trans-expr.c (gfc_trans_assignment_1): If the rhs is an op
	expr and is assigned to a deferred character length scalar,
	make sure that the function is called before reallocation,
	so that the length is available. Include procedure pointer
	and procedure pointer component rhs as well.

	PR fortran/45170
	PR fortran/35810
	PR fortran/47350
	* gfortran.dg/allocatable_function_5.f90: New test not added by
	mistake on 2011-01-28.

From-SVN: r169413

gcc/fortran/ChangeLog

+2011-01-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/47523
+	* trans-expr.c (gfc_trans_assignment_1): If the rhs is an op
+	expr and is assigned to a deferred character length scalar,
+	make sure that the function is called before reallocation,
+	so that the length is available. Include procedure pointer
+	and procedure pointer component rhs as well.
+
+	PR fortran/45170
+	PR fortran/35810
+	PR fortran/47350
+	* gfortran.dg/allocatable_function_5.f90: New test not added by
+	mistake on 2011-01-28.
+
 2011-01-29  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/47531

gcc/fortran/trans-expr.c

@@ -5977,6 +5977,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   stmtblock_t body;
   bool l_is_temp;
   bool scalar_to_array;
+  bool def_clen_func;
   tree string_length;
   int n;
 
@@ -6097,10 +6098,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   /* 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);
   if (gfc_option.flag_realloc_lhs
-	&& expr2->expr_type == EXPR_FUNCTION
 	&& expr2->ts.type == BT_CHARACTER
-	&& expr2->ts.deferred)
+	&& (def_clen_func || expr2->expr_type == EXPR_OP)
+	&& expr1->ts.deferred)
     gfc_add_block_to_block (&block, &rse.pre);
 
   tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,

gcc/testsuite/ChangeLog

+2011-01-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/47523
+	* gfortran.dg/realloc_on_assign_5.f03: New test.
+
 2011-01-29  Ulrich Weigand  <Ulrich.Weigand@de.ibm.com>
 
 	* gfortran.dg/bessel_6.f90: XFAIL on spu-*-*.
@@ -66,9 +71,8 @@
 	PR fortran/47350
 	* gfortran.dg/realloc_on_assign_3.f03: New test.
 	* gfortran.dg/realloc_on_assign_4.f03: New test.
-	* gfortran.dg/realloc_on_assign_5.f90: New test.
 	* gfortran.dg/allocatable_function_5.f90: New test.
-	* gfortran.dg/allocate_deferred_char_scalar_1.f90: New test.
+	* gfortran.dg/allocate_deferred_char_scalar_1.f03: New test.
 	* gfortran.dg/deferred_type_param_2.f90: Remove two "not yet
 	implemented" dg-errors.
 

gcc/testsuite/gfortran.dg/allocatable_function_5.f90

+! { dg-do run }
+! Tests function return of deferred length scalars.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module m
+contains
+  function mfoo (carg) result(res)
+    character (:), allocatable :: res
+    character (*) :: carg
+    res = carg(2:4)
+  end function
+  function mbar (carg)
+    character (:), allocatable :: mbar
+    character (*) :: carg
+    mbar = carg(2:13)
+  end function
+end module
+
+  use m
+  character (:), allocatable :: lhs
+  lhs = foo ("foo calling ")
+  if (lhs .ne. "foo") call abort
+  if (len (lhs) .ne. 3) call abort
+  deallocate (lhs)
+  lhs = bar ("bar calling - baaaa!")
+  if (lhs .ne. "bar calling") call abort
+  if (len (lhs) .ne. 12) call abort
+  deallocate (lhs)
+  lhs = mfoo ("mfoo calling ")
+  if (lhs .ne. "foo") call abort
+  if (len (lhs) .ne. 3) call abort
+  deallocate (lhs)
+  lhs = mbar ("mbar calling - baaaa!")
+  if (lhs .ne. "bar calling") call abort
+  if (len (lhs) .ne. 12) call abort
+contains
+  function foo (carg) result(res)
+    character (:), allocatable :: res
+    character (*) :: carg
+    res = carg(1:3)
+  end function
+  function bar (carg)
+    character (:), allocatable :: bar
+    character (*) :: carg
+    bar = carg(1:12)
+  end function
+end

gcc/testsuite/gfortran.dg/realloc_on_assign_5.f03

+! { dg-do run }
+! Test the fix for PR47523 in which concatenations did not work
+! correctly with assignments to deferred character length scalars.
+!
+! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+program main
+  implicit none
+  character(:), allocatable :: a, b
+  a = 'a'
+  if (a .ne. 'a') call abort
+  a = a // 'x'
+  if (a .ne. 'ax') call abort
+  if (len (a) .ne. 2) call abort
+  a = (a(2:2))
+  if (a .ne. 'x') call abort
+  if (len (a) .ne. 1) call abort
+end program main