[PATCH] Fortran: fix ICE in check_charlen_present [PR108420]

[Harald Anlauf <anlauf@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 538 bytes --]

Dear all,

it appears that the fix for pr107874 uncovered a latent bug
for the case of arrays of type character and size zero when
passed to the intrinsics MERGE and SPREAD as SOURCE.  In that
case, there is no constructor from which we could obtain
another character length.  A reasonable solution seems to
retain the array's character length.

Since I could not find a simple case where this fails, I've
added an assertion that we actually have a meaningful length.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr108420.diff --]
[-- Type: text/x-patch, Size: 1937 bytes --]

From a4fbab560a202f4541f8f9a872774b2cbf72b4b0 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 16 Jan 2023 21:41:09 +0100
Subject: [PATCH] Fortran: fix ICE in check_charlen_present [PR108420]

gcc/fortran/ChangeLog:

	PR fortran/108420
	* iresolve.cc (check_charlen_present): Preserve character length if
	there is no array constructor.

gcc/testsuite/ChangeLog:

	PR fortran/108420
	* gfortran.dg/pr108420.f90: New test.
---
 gcc/fortran/iresolve.cc                |  9 ++++++---
 gcc/testsuite/gfortran.dg/pr108420.f90 | 10 ++++++++++
 2 files changed, 16 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr108420.f90

diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 711e9178ad4..33794f0a858 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -94,9 +94,12 @@ check_charlen_present (gfc_expr *source)
   else if (source->expr_type == EXPR_ARRAY)
     {
       gfc_constructor *c = gfc_constructor_first (source->value.constructor);
-      source->ts.u.cl->length
-		= gfc_get_int_expr (gfc_charlen_int_kind, NULL,
-				    c->expr->value.character.length);
+      if (c)
+	source->ts.u.cl->length
+	  = gfc_get_int_expr (gfc_charlen_int_kind, NULL,
+			      c->expr->value.character.length);
+      if (source->ts.u.cl->length == NULL)
+	gfc_internal_error ("check_charlen_present(): length not set");
     }
 }

diff --git a/gcc/testsuite/gfortran.dg/pr108420.f90 b/gcc/testsuite/gfortran.dg/pr108420.f90
new file mode 100644
index 00000000000..985c0b3bf53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr108420.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/108420
+! Contributed by G.Steinmetz
+
+program p
+  character :: c = 'c'
+  logical   :: m = .true.
+  print *, merge(transfer('a', 'b', 0), c, .true.)
+  print *, merge(transfer('a', 'b', 0), c, m)
+end
--
2.35.3