[Patch, Fortran] PR45170 - Fix deferred-length issue

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

This patch fixes an ordering problem with deferred string lengths. For

  str = str2(:nn)

where "nn" is a something a tad more complicated than a local variable 
(e.g. a non-VALUE dummy argument), the result was wrong: the temporary 
variable with the string length was used before it was set.

The attached patch fixes the issue. However, I wonder whether the block 
should/could always be added.

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

 * * *

Remaining deferred-length issues:

- PR 47674: a = a(:n); reallocation messed up; "realloc" should be 
enough as the length has to be always <= previous length [memory content 
is then guaranteed to remain untouched]. Alternatively, a temporary is 
required
- PR 49954: String length is wrong for "array(:)(1:1)": It's wrongly the 
one of "array" instead of 1; there might be some extra issues.
- PR 50221: Some odd array assignment issues.
- PR 51976: Deferred-string components. Needs a hidden component for the 
string length. Tricky: expr->ts.u.cl->backend_decl is wrong as that 
points to the component - missing the component ref ("var->comp"). 
Similar to the issue of PR49954.

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

	PR fortran/45170
	* trans-expr.c (gfc_trans_assignment_1): Fix handling of RHS
	string lengths for deferred-length LHS.
	(gfc_trans_scalar_assign): Remove superfluous gcc_assert.

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

	PR fortran/45170
	* gfortran.dg/deferred_type_param_7.f90: New.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9d48a09..ce915b6 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6106,7 +6110,6 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
 
       if (rse->string_length != NULL_TREE)
 	{
-	  gcc_assert (rse->string_length != NULL_TREE);
 	  gfc_conv_string_parameter (rse);
 	  gfc_add_block_to_block (&block, &rse->pre);
 	  rlen = rse->string_length;
@@ -6891,7 +6897,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 +7015,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-05-24 07:57:26.555773053 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_7.f90	2012-05-24 15:18:26.000000000 +0200
@@ -0,0 +1,64 @@
+! { dg-do run }
+!
+! PR fortran/45170
+!
+! Contribued by Steve Kargl
+!
+
+PROGRAM helloworld
+  implicit none
+  character(:),allocatable::string
+  character(11), parameter :: cmpstring = "hello world"
+  real::rnd
+  integer :: i, cnt
+  do i = 1, 100
+     call random_number(rnd)
+     cnt = floor(12*rnd)
+
+     if (allocated (string) .and. mod(i, 3) == 0) deallocate (string)
+     call hello1 (cnt, string)
+     if (len(string) /= cnt .or. string /= cmpstring(1:cnt)) call abort ()
+
+     if (allocated (string) .and. mod(i, 5) == 0) deallocate (string)
+     call hello2 (cnt, string)
+     if (len(string) /= cnt .or. string /= cmpstring(1:cnt)) call abort ()
+
+     if (allocated (string) .and. mod(i, 7) == 0) deallocate (string)
+     call hello3 (cnt, string)
+     if (len(string) /= cnt .or. string /= cmpstring(1:cnt)) call abort ()
+
+     if (allocated (string) .and. mod(i, 9) == 0) deallocate (string)
+     call hello4 (cnt, string)
+     if (len(string) /= cnt .or. string /= cmpstring(1:cnt)) call abort ()
+
+!     print '(A,1X,I0)', '>' // string // '<', len(string)
+  end do
+contains
+  subroutine hello1 (n,string)
+    character(:),allocatable,intent(out)::string
+    integer,intent(in)::n
+    character(11)::helloworld="hello world"
+    string=helloworld(:n)                      ! Does not work.
+  end subroutine hello1
+
+  subroutine hello2 (n,string)
+    character(:),allocatable,intent(out)::string
+    integer,intent(in)::n
+    character(11)::helloworld="hello world"
+    string=(helloworld(:n))
+  end subroutine hello2
+
+  subroutine hello3 (n,string)
+    character(:),allocatable,intent(out)::string
+    integer,intent(in)::n
+    character(11)::helloworld="hello world"
+    allocate(string, source=helloworld(:n))
+  end subroutine hello3
+
+  subroutine hello4 (n,string)
+    character(:),allocatable,intent(out)::string
+    integer,intent(in)::n
+    character(11)::helloworld="hello world"
+    allocate(string, source=(helloworld(:n)))
+  end subroutine hello4
+end PROGRAM helloworld