[gcc r10-9177] PR fortran/93685 - ICE in gfc_constructor_append_expr, at fortran/constructor.c:135

[gcc r10-9177] PR fortran/93685 - ICE in gfc_constructor_append_expr, at fortran/constructor.c:135

[Harald Anlauf]

https://gcc.gnu.org/g:435e0cd4a06db5bdc5fc057e8cc7db21f4b3b421

commit r10-9177-g435e0cd4a06db5bdc5fc057e8cc7db21f4b3b421
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Fri Dec 25 15:40:39 2020 +0100

    PR fortran/93685 - ICE in gfc_constructor_append_expr, at fortran/constructor.c:135
    
    Fix handling of F2018 enhancements to DATA statements that allows
    initialization of pointer components to derived types, and adjust error
    handling for the CHARACTER case.
    
    gcc/fortran/ChangeLog:
    
            * data.c (gfc_assign_data_value): Restrict use of
            create_character_initializer to constant initializers.
            * trans-expr.c (gfc_conv_initializer): Ensure that character
            initializer is constant, otherwise fall through to get the same
            error handling as for non-character cases.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/pr93685_1.f90: New test.
            * gfortran.dg/pr93685_2.f90: New test.
    
    (cherry picked from commit 6e36772ba6a8173318c173508bd3254e4140b726)

Diff:
---
 gcc/fortran/data.c                      |  7 +++----
 gcc/fortran/trans-expr.c                | 12 +++++++-----
 gcc/testsuite/gfortran.dg/pr93685_1.f90 | 20 ++++++++++++++++++++
 gcc/testsuite/gfortran.dg/pr93685_2.f90 | 18 ++++++++++++++++++
 4 files changed, 48 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 5147515659b..8efcf8fb522 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -498,12 +498,11 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
 	return false;
     }
 
-  if (ref || last_ts->type == BT_CHARACTER)
+  if (ref || (last_ts->type == BT_CHARACTER
+	      && rvalue->expr_type == EXPR_CONSTANT))
     {
       /* An initializer has to be constant.  */
-      if (rvalue->expr_type != EXPR_CONSTANT
-	  || (lvalue->ts.u.cl->length == NULL
-	      && !(ref && ref->u.ss.length != NULL)))
+      if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
 	return false;
       expr = create_character_initializer (init, last_ts, ref, rvalue);
     }
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 25ffd4891a5..39c4e11f235 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7703,12 +7703,14 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
 	  return se.expr;
 
 	case BT_CHARACTER:
-	  {
-	    tree ctor = gfc_conv_string_init (ts->u.cl->backend_decl,expr);
-	    TREE_STATIC (ctor) = 1;
-	    return ctor;
-	  }
+	  if (expr->expr_type == EXPR_CONSTANT)
+	    {
+	      tree ctor = gfc_conv_string_init (ts->u.cl->backend_decl, expr);
+	      TREE_STATIC (ctor) = 1;
+	      return ctor;
+	    }
 
+	  /* Fallthrough.  */
 	default:
 	  gfc_init_se (&se, NULL);
 	  gfc_conv_constant (&se, expr);
diff --git a/gcc/testsuite/gfortran.dg/pr93685_1.f90 b/gcc/testsuite/gfortran.dg/pr93685_1.f90
new file mode 100644
index 00000000000..34d6e2cf355
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93685_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR93685 - ICE in gfc_constructor_append_expr, at fortran/constructor.c:135
+
+program p
+  implicit none
+  type t
+     character, pointer :: a
+  end type t
+  type u
+     integer,   pointer :: i
+  end type u
+  type(t) :: x
+  type(u) :: y
+  character, target :: c = 'c'
+  integer  , target :: i = 10
+  data x%a /c/
+  data y%i /i/
+  if (x% a /= "c") stop 1
+  if (y% i /= 10)  stop 2
+end
diff --git a/gcc/testsuite/gfortran.dg/pr93685_2.f90 b/gcc/testsuite/gfortran.dg/pr93685_2.f90
new file mode 100644
index 00000000000..a09ce7e5a2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93685_2.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR93685 - ICE in gfc_constructor_append_expr, at fortran/constructor.c:135
+
+program p
+  implicit none
+  type t
+     character :: a
+  end type t
+  type u
+     integer   :: i
+  end type u
+  type(t) :: x
+  type(u) :: y
+  character, target :: c = 'c'
+  integer  , target :: i = 10
+  data x%a /c/  ! { dg-error "non-constant initialization expression" }
+  data y%i /i/  ! { dg-error "non-constant initialization expression" }
+end