From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Wed, 16 Aug 2017 17:21:22 +0000 (+0000)
Subject: re PR fortran/81116 (Last character of allocatable-length string reset to blank in... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b68a9f34f170f48a08c737d1cbfdc147dc42f275;p=gcc.git

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

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 24e5a244db8..4a572cfb4ae 100644
--- 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 11c75035210..7a3d0272d47 100644
--- 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 2b4c63ab712..260cc38a0fd 100644
--- 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
index 00000000000..e7a7d2899d2
--- /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