re PR fortran/81116 (Last character of allocatable-length string reset to blank in...

2017-08-16  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/81116
	* frontend-passes.c (realloc_string_callback): If expression is a
	concatenation, also check for dependency.
	(constant_string_length): Check for presence of symtree.

2017-08-16  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/81116
	* gfortran.dg/realloc_on_assignment_29.f90:  New test.

From-SVN: r251125

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 24e5a244db85ce940bcb4f03a8516db0e2b3ef1f..4a572cfb4ae9251b286d7bc9d9d51c225c8c75a8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2017-08-16  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/81116
+       * frontend-passes.c (realloc_string_callback): If expression is a
+       concatenation, also check for dependency.
+       (constant_string_length): Check for presence of symtree.
+
 2017-08-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        * gfortran.texi: Document format of unformatted sequential files.

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 11c750352104ab468600c96536953508f8e7453e..7a3d0272d47484488f9183722218531e8ebab89c 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -238,21 +238,25 @@ realloc_string_callback (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
     return 0;
 
   expr2 = gfc_discard_nops (co->expr2);
-  if (expr2->expr_type != EXPR_VARIABLE)
-    return 0;
 
-  found_substr = false;
-  for (ref = expr2->ref; ref; ref = ref->next)
+  if (expr2->expr_type == EXPR_VARIABLE)
     {
-      if (ref->type == REF_SUBSTRING)
+      found_substr = false;
+      for (ref = expr2->ref; ref; ref = ref->next)
        {
-         found_substr = true;
-         break;
+         if (ref->type == REF_SUBSTRING)
+           {
+             found_substr = true;
+             break;
+           }
        }
+      if (!found_substr)
+       return 0;
     }
-  if (!found_substr)
+  else if (expr2->expr_type != EXPR_OP
+          || expr2->value.op.op != INTRINSIC_CONCAT)
     return 0;
-
+  
   if (!gfc_check_dependency (expr1, expr2, true))
     return 0;
 
@@ -625,7 +629,8 @@ constant_string_length (gfc_expr *e)
 
   /* Return length of char symbol, if constant.  */
 
-  if (e->symtree->n.sym->ts.u.cl && e->symtree->n.sym->ts.u.cl->length
+  if (e->symtree && e->symtree->n.sym->ts.u.cl
+      && e->symtree->n.sym->ts.u.cl->length
       && e->symtree->n.sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
     return gfc_copy_expr (e->symtree->n.sym->ts.u.cl->length);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2b4c63ab7123f2510f4a9c1312af81910e583ea8..260cc38a0fd0a399f1892c32a23a935f571af8fd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-08-16  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/81116
+       * gfortran.dg/realloc_on_assignment_29.f90:  New test.
+
 2017-08-16  Uros Bizjak  <ubizjak@gmail.com>
 
        PR target/46091

diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_29.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_29.f90
new file mode 100644 (file)
index 0000000..e7a7d28
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_29.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR fortran/81116
+! The assignment was broken due to a missing temporary.
+! Original test case by Clive Page.
+
+program test10
+  implicit none
+  character(:), allocatable :: string
+  !
+  string = '1234567890'
+  string = string(1:5) // string(7:)
+  if (string /= '123457890') call abort
+end program test10