re PR fortran/53642 (Front-end optimization: Wrong string length for deferred-length strings)

2012-06-16  Tobias Burnus  <burnus@net-b.de>

        PR fortran/53642
        PR fortran/45170
        * frontend-passes.c (optimize_assignment): Don't remove RHS's
        trim when assigning to a deferred-length string.
        * trans-expr.c (gfc_trans_assignment_1): Ensure that the RHS string
        length is evaluated before the deferred-length LHS is reallocated.

2012-06-16  Tobias Burnus  <burnus@net-b.de>

        PR fortran/53642
        PR fortran/45170
        * gfortran.dg/deferred_type_param_8.f90: New.

From-SVN: r188692

5 files changed, 76 insertions, 15 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 27c0679..845a534 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2012-06-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/53642
+	PR fortran/45170
+	* frontend-passes.c (optimize_assignment): Don't remove RHS's
+	trim when assigning to a deferred-length string.
+	* trans-expr.c (gfc_trans_assignment_1): Ensure that the RHS string
+	length is evaluated before the deferred-length LHS is reallocated.
+
 2012-06-13  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/53643
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index bcc1bdc..fc32e56 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -735,15 +735,13 @@ optimize_assignment (gfc_code * c)
   lhs = c->expr1;
   rhs = c->expr2;
 
-  if (lhs->ts.type == BT_CHARACTER)
+  if (lhs->ts.type == BT_CHARACTER && !lhs->ts.deferred)
     {
-      /* Optimize away a = trim(b), where a is a character variable.  */
+      /* Optimize  a = trim(b)  to  a = b.  */
       remove_trim (rhs);
 
-      /* Replace a = '   ' by a = '' to optimize away a memcpy, but only
-	 for strings with non-deferred length (otherwise we would
-	 reallocate the length.  */
-      if (empty_string(rhs) && ! lhs->ts.deferred)
+      /* Replace a = '   ' by a = '' to optimize away a memcpy.  */
+      if (empty_string(rhs))
 	rhs->value.character.length = 0;
     }
 
@@ -1171,7 +1169,7 @@ optimize_trim (gfc_expr *e)
 
   ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
 
-  /* Build the function call to len_trim(x, gfc_defaul_integer_kind).  */
+  /* Build the function call to len_trim(x, gfc_default_integer_kind).  */
 
   fcn = get_len_trim_call (gfc_copy_expr (e), gfc_default_integer_kind);
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9d48a09..7d1a6d4 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6891,7 +6891,6 @@ 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;
 
@@ -7010,13 +7009,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
      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 saves 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)
+  if (gfc_option.flag_realloc_lhs && expr2->ts.type == BT_CHARACTER
+      && 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 bcff7571..42d8f7c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2012-06-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/53642                                                                                                                                                           
+	PR fortran/45170                                                                                                                                                           
+	* gfortran.dg/deferred_type_param_8.f90: New.                                                                                                                              
+
 2012-06-15  Janis Johnson  <janosjo@codesourcery.com>
 
 	* lib/gcov.exp (verify-lines, verify-branches, verify-calls): Use
diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_8.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_8.f90
new file mode 100644
index 0000000..3c768c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_param_8.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+!
+! PR fortran/53642
+! PR fortran/45170 (comments 24, 34, 37)
+!
+
+PROGRAM helloworld
+  implicit none
+  character(:),allocatable::string
+  character(11), parameter :: cmp = "hello world"
+  real::rnd
+  integer :: n, i
+  do i = 1, 10
+     call random_number(rnd)
+     n = ceiling(11*rnd)
+     call hello(n, string)
+!     print '(A,1X,I0)', '>' // string // '<', len(string)
+     if (n /= len (string) .or. string /= cmp(1:n)) call abort ()
+  end do
+
+  call test_PR53642()
+
+contains
+
+  subroutine hello (n,string)
+    character(:), allocatable, intent(out) :: string
+    integer,intent(in) :: n
+    character(11) :: helloworld="hello world"
+
+    string=helloworld(:n)                       ! Didn't  work
+!    string=(helloworld(:n))                    ! Works.
+!    allocate(string, source=helloworld(:n))    ! Fixed for allocate_with_source_2.f90
+!    allocate(string, source=(helloworld(:n)))  ! Works.
+  end subroutine hello
+
+  subroutine test_PR53642()
+    character(len=4) :: string="123 "
+    character(:), allocatable :: trimmed
+
+    trimmed = trim(string)
+    if (len_trim(string) /= len(trimmed)) call abort ()
+    if (len(trimmed) /= 3) call abort ()
+    if (trimmed /= "123") call abort ()
+!    print *,len_trim(string),len(trimmed)
+
+    ! Clear
+    trimmed = "XXXXXX"
+    if (trimmed /= "XXXXXX" .or. len(trimmed) /= 6) call abort ()
+
+    trimmed = string(1:len_trim(string))
+    if (len_trim(trimmed) /= 3) call abort ()
+    if (trimmed /= "123") call abort ()
+  end subroutine test_PR53642
+end PROGRAM helloworld