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 --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 5147515659bb11552cb4db0267d85fe26d22be1d..8efcf8fb522420a4765fcc9d5d8afbd6cf8a0fff 100644 (file)
--- 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 25ffd4891a5dfb352c4bb7573e641c0e4cea9ee1..39c4e11f2357bfdcb4cac8f49c8a0e694fdf5414 100644 (file)
--- 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 (file)
index 0000000..34d6e2c
--- /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 (file)
index 0000000..a09ce7e
--- /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