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

5 files changed, 94 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b1df405..ce56256 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+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
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9bbe791..9682802 100644
--- a/gcc/fortran/trans-expr.c
+++ b/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,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ece39bc..a9e1645 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.
 
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_5.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_5.f90
new file mode 100644
index 0000000..8e7d49b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_5.f90
@@ -0,0 +1,48 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_5.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_5.f03
new file mode 100644
index 0000000..db4233d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_5.f03
@@ -0,0 +1,18 @@
+! { 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