diff mbox

[Fortran] PR53642/45170c24 Deferred-length string fixes

Message ID 4FD8489B.5080906@net-b.de
State New
Headers show

Commit Message

Tobias Burnus June 13, 2012, 8 a.m. UTC 
This patch fixes issues with deferred length strings, where the new 
string length (= RHS len) is evaluated too late. That's fixed by calling 
gfc_add_block_to_block. I have no idea whether the condition makes sense 
or whether that function could always be called.

Additionally, in the FE optimization, it avoids the removal of trim in 
"lhs = trim(rhs)" if the lhs has a deferred length.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

Comments

Tobias Burnus June 16, 2012, 10:22 a.m. UTC | #1 
Om 13.06.2012 10:00, Tobias Burnus wrote:
> This patch fixes issues with deferred length strings, where the new 
> string length (= RHS len) is evaluated too late. That's fixed by 
> calling gfc_add_block_to_block. I have no idea whether the condition 
> makes sense or whether that function could always be called.
>
> Additionally, in the FE optimization, it avoids the removal of trim in 
> "lhs = trim(rhs)" if the lhs has a deferred length.
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias
Thomas Koenig June 16, 2012, 5:11 p.m. UTC | #2 
Hi Tobias,

>> Build and regtested on x86-64-linux.
>> OK for the trunk?
>>
>> Tobias

OK.

Thanks a lot for the patch!

	Thomas
diff mbox

Patch

2012-06-13  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/53642
	PR fortran/45170
	* gfortran.dg/deferred_type_param_8.f90: New.

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,
--- /dev/null	2012-06-12 08:13:11.079779038 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_8.f90	2012-06-13 09:30:31.000000000 +0200
@@ -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