Hello world,

the attached patch fixes the PR by adding a dependency check
for the case of concatenation operators.

Regression-tested.  OK for trunk?

Regards

        Thomas

2017-08-07  Thomas Koenig  <tkoe...@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-07  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/81116
        * gfortran.dg/realloc_on_assignment_29.f90:  New test.
Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 250720)
+++ frontend-passes.c	(Arbeitskopie)
@@ -238,21 +238,25 @@ realloc_string_callback (gfc_code **c, int *walk_s
     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);
 
! { 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

Reply via email to