[patch, committed] Fix gcc-7 regression in front-end optimization

[Thomas Koenig]

Hello world,

I have just committed the attached patch as obvious after 
regresson-testing - it fixed a rare beast, a gcc 7.4-only regression.

I have also committed the test case to trunk, to make sure that
this does not re-break.  No real need to commit to the other
branches, I think.

Regards

        Thomas

2019-05-05  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/90344
        * frontend-passes.c (create_var): Bring into sync with gcc 8.

2019-05-05  Thomas Koenig <tkoe...@gcc.gnu.org>

        PR fortran/90344
        * gfortran.dg/pr90344.f90: New test.
Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 270881)
+++ frontend-passes.c	(Arbeitskopie)
@@ -701,6 +701,11 @@ create_var (gfc_expr * e, const char *vname)
   if (e->expr_type == EXPR_CONSTANT || is_fe_temp (e))
     return gfc_copy_expr (e);
 
+  /* Creation of an array of unknown size requires realloc on assignment.
+     If that is not possible, just return NULL.  */
+  if (flag_realloc_lhs == 0 && e->rank > 0 && e->shape == NULL)
+    return NULL;
+
   ns = insert_block ();
 
   if (vname)
@@ -748,7 +753,7 @@ create_var (gfc_expr * e, const char *vname)
     }
 
   deferred = 0;
-  if (e->ts.type == BT_CHARACTER && e->rank == 0)
+  if (e->ts.type == BT_CHARACTER)
     {
       gfc_expr *length;
 
@@ -759,6 +764,8 @@ create_var (gfc_expr * e, const char *vname)
       else
 	{
 	  symbol->attr.allocatable = 1;
+	  symbol->ts.u.cl->length = NULL;
+	  symbol->ts.deferred = 1;
 	  deferred = 1;
 	}
     }
@@ -771,7 +778,7 @@ create_var (gfc_expr * e, const char *vname)
 
   result = gfc_get_expr ();
   result->expr_type = EXPR_VARIABLE;
-  result->ts = e->ts;
+  result->ts = symbol->ts;
   result->ts.deferred = deferred;
   result->rank = e->rank;
   result->shape = gfc_copy_shape (e->shape, e->rank);
! { dg-do compile }
! { dg-additional-options "-ffrontend-optimize" }
! PR 90344 - this used to ICE.
! Test case by Urban Jost.
module M_xterm
contains
   elemental function func1(ch) result(res)
      character,intent(in) :: ch
      logical              :: res
      res=.true.
   end function func1
   elemental function func2(ch) result(res)
      character,intent(in) :: ch
      logical              :: res
      res=.false.
   end function func2
   pure function s2a(string)  RESULT (array)
      character(len=*),intent(in) :: string
      character(len=1)            :: array(len(string))
      forall(i=1:len(string)) array(i) = string(i:i)
   end function s2a
   subroutine sub1()
      write(*,*)all(func1(s2a('ABCDEFG')).or.func2(s2a('ABCDEFG')))
   end subroutine sub1
end module M_xterm