From 6e36772ba6a8173318c173508bd3254e4140b726 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 25 Dec 2020 15:40:39 +0100
Subject: [PATCH] PR93685 - 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.
---
 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(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr93685_1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr93685_2.f90

diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 3e52a5717b5..76ddd9dab7f 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -546,12 +546,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 bfe08be2a94..f66afab85d1 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7877,12 +7877,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
-- 
2.30.2