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.

diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 3e52a5717b5017c45f5cec239630fdb14cdf43e0..76ddd9dab7f80c7deb53e574f0c3d6982d425fd0 100644 (file)
--- 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 bfe08be2a94121a7295aa277a9fee5b891fc0d6f..f66afab85d11b5c3c5af1de467e35314de2e37f6 100644 (file)
--- 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 (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