re PR fortran/29912 ([4.1 only] Gfortran: string array functions behaving incorrectly...)

2006-12-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29912
	* trans-expr.c (gfc_trans_arrayfunc_assign): Return NULL if the
	lhs and rhs character lengths are not constant and equal for
	character array valued functions.

2006-12-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29912
	* gfortran.dg/char_result_12.f90: New test.

From-SVN: r119554

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index eeaaa481b2a4b8be79470942d0ede7a0b2d79f46..a65b4a7319600d7cf4ff3a0ab4145b47273998a2 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2006-12-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/29912
+       * trans-expr.c (gfc_trans_arrayfunc_assign): Return NULL if the
+       lhs and rhs character lengths are not constant and equal for
+       character array valued functions.
+
 2006-12-04  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/29962

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3505236ab47703590e2d6f5254757634e929b1d7..7c064ffd827f64976390c4a828bf1a528f7d814d 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3382,6 +3382,23 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
       || expr2->symtree->n.sym->attr.allocatable)
     return NULL;
 
+  /* Character array functions need temporaries unless the
+     character lengths are the same.  */
+  if (expr2->ts.type == BT_CHARACTER && expr2->rank > 0)
+    {
+      if (expr1->ts.cl->length == NULL
+           || expr1->ts.cl->length->expr_type != EXPR_CONSTANT)
+       return NULL;
+
+      if (expr2->ts.cl->length == NULL
+           || expr2->ts.cl->length->expr_type != EXPR_CONSTANT)
+       return NULL;
+
+      if (mpz_cmp (expr1->ts.cl->length->value.integer,
+                    expr2->ts.cl->length->value.integer) != 0)
+       return NULL;
+    }
+
   /* Check that no LHS component references appear during an array
      reference. This is needed because we do not have the means to
      span any arbitrary stride with an array descriptor. This check

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0d6d814490245ae34ed6ad01ca582ded9774f0c7..363e298502a2b124e281df4c09cc2b73fc37aa70 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-12-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/29912
+       * gfortran.dg/char_result_12.f90: New test.
+
 2006-12-05  Richard Guenther  <rguenther@suse.de>
 
        * gcc.dg/vect/vect.exp: Add support for -fno-math-errno tests.

diff --git a/gcc/testsuite/gfortran.dg/char_result_12.f90 b/gcc/testsuite/gfortran.dg/char_result_12.f90
new file mode 100644 (file)
index 0000000..b6ddfc0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_12.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Tests the fix for PR29912, in which the call to JETTER
+! would cause a segfault beause a temporary was not being written.
+!
+! COntributed by Philip Mason  <pmason@ricardo.com>
+!
+ program testat
+ character(len=4)   :: ctemp(2)
+ character(len=512) :: temper(2)
+ !
+ !------------------------
+ !'This was OK.'
+ !------------------------
+ temper(1) = 'doncaster'
+ temper(2) = 'uxbridge'
+ ctemp     = temper
+ if (any (ctemp /= ["donc", "uxbr"])) call abort ()
+ !
+ !------------------------
+ !'This went a bit wrong.'
+ !------------------------
+ ctemp = jetter(1,2)
+ if (any (ctemp /= ["donc", "uxbr"])) call abort ()
+
+ contains
+   function jetter(id1,id2)
+   character(len=512) :: jetter(id1:id2)
+   jetter(id1) = 'doncaster'
+   jetter(id2) = 'uxbridge'
+   end function jetter
+ end program testat