re PR fortran/38915 (wrong results for structure assignment of character components when left and right sides overlap)

2009-03-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38915
	* trans-expr.c (gfc_trans_assignment_1): Ensure temporaries
	have a string_length.

2009-03-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38915
	* gfortran.dg/char_length_15.f90: New test.

From-SVN: r145370

4 files changed, 56 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c7ed02d..ef6d2b5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -137,6 +137,12 @@
 	Add 2009 to copyright years.
 	* trans.c (gfc_trans_code): Likewise on both counts.
 
+2009-03-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38915
+	* trans-expr.c (gfc_trans_assignment_1): Ensure temporaries
+	have a string_length.
+
 2009-03-28  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/34656
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 91485d1..dcbccef 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4585,6 +4585,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;
+  tree string_length;
 
   /* Assignment of the form lhs = rhs.  */
   gfc_start_block (&block);
@@ -4660,10 +4661,18 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
   /* Translate the expression.  */
   gfc_conv_expr (&rse, expr2);
 
+  /* Stabilize a string length for temporaries.  */
+  if (expr2->ts.type == BT_CHARACTER)
+    string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
+  else
+    string_length = NULL_TREE;
+
   if (l_is_temp)
     {
       gfc_conv_tmp_array_ref (&lse);
       gfc_advance_se_ss_chain (&lse);
+      if (expr2->ts.type == BT_CHARACTER)
+	lse.string_length = string_length;
     }
   else
     gfc_conv_expr (&lse, expr1);
@@ -4718,6 +4727,9 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
 	  gcc_assert (lse.ss == gfc_ss_terminator
 		      && rse.ss == gfc_ss_terminator);
 
+	  if (expr2->ts.type == BT_CHARACTER)
+	    rse.string_length = string_length;
+
 	  tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
 					 false, false);
 	  gfc_add_expr_to_block (&body, tmp);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7d71e74..e2f3a2a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-03-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38915
+	* gfortran.dg/char_length_15.f90: New test.
+
 2009-03-31  Jason Merrill  <jason@redhat.com>
 
 	* g++.dg/other/typedef2.C: New test.
diff --git a/gcc/testsuite/gfortran.dg/char_length_15.f90 b/gcc/testsuite/gfortran.dg/char_length_15.f90
new file mode 100644
index 0000000..700da0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_15.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Test the fix for PR38915 in which the character length of the
+! temporaries produced in the assignments marked below was set to
+! one.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+program cg0033_41
+  type t
+    sequence
+    integer i
+    character(len=9) c
+  end type t
+  type (t)  L(3),R(3), LL(4), RR(4)
+  EQUIVALENCE (L,LL)
+  integer nfv1(3), nfv2(3)
+  R(1)%c = '123456789'
+  R(2)%c = 'abcdefghi'
+  R(3)%c = '!@#$%^&*('
+  L%c = R%c
+  LL(1:3)%c = R%c
+  LL(4)%c = 'QWERTYUIO'
+  RR%c = LL%c            ! The equivalence forces a dependency
+  L%c = LL(2:4)%c
+  if (any (RR(2:4)%c .ne. L%c)) call abort
+  nfv1 = (/1,2,3/)
+  nfv2 = nfv1
+  L%c = R%c
+  L(nfv1)%c = L(nfv2)%c  ! The vector indices force a dependency
+  if (any (R%c .ne. L%c)) call abort
+end
+