Re: [Patch, fortran] PR93833 - [8/9/10 Regression] ICE in trans_array_constructor, at fortran/trans-array.c:2566

[Paul Richard Thomas via Gcc-patches]

Hi All,

I am in the midst of an end-of-year tidy up and found this:

On Wed, 1 Apr 2020 at 18:07, Fritz Reese <fritzore...@gmail.com> wrote:

> Unfortunately the mailing list stripped off this attachment so we do
> not have a chance to review. As attachments appear to be working
> lately, please resubmit this patch.
>
>
Retested on FC33/x86_64 - OK for master, then 9&10 branches in a few weeks?

Paul

Fortran: Fix deferred character lengths in array constructors [PR93833].

2020-12-28  Paul Thomas  <pa...@gcc.gnu.org>

gcc/fortran
PR fortran/93833
* trans-array.c (get_array_ctor_var_strlen): If the character
length backend_decl cannot be found, convert the expression and
use the string length. Clear up some minor white space issues
in the rest of the file.

gcc/testsuite/
PR fortran/93833
* gfortran.dg/deferred_character_36.f90 : New test.

! { dg-do run }
!
! Test the fix for PR93833, which ICEd as shown.
!
! Contributed by Gerhard Steinmetz  <gs...@t-online.de>
!
program p
   character(:), allocatable :: c
   c = "wxyz"
contains
   subroutine s
      associate (y => [c])
         if (any(y /= [c])) stop 1
      end associate
   end
end

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2c6be710ac8..33e05be5bd1 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2199,6 +2199,7 @@ get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len)
   gfc_ref *ref;
   gfc_typespec *ts;
   mpz_t char_len;
+  gfc_se se;
 
   /* Don't bother if we already know the length is a constant.  */
   if (*len && INTEGER_CST_P (*len))
@@ -2244,6 +2245,19 @@ get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len)
 	}
     }
 
+  /* A last ditch attempt that is sometimes needed for deferred characters.  */
+  if (!ts->u.cl->backend_decl)
+    {
+      gfc_init_se (&se, NULL);
+      if (expr->rank)
+	gfc_conv_expr_descriptor (&se, expr);
+      else
+	gfc_conv_expr (&se, expr);
+      gcc_assert (se.string_length != NULL_TREE);
+      gfc_add_block_to_block (block, &se.pre);
+      ts->u.cl->backend_decl = se.string_length;
+    }
+
   *len = ts->u.cl->backend_decl;
 }