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

2020-12-29  Paul Thomas  <pault@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.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2c6be710ac8be70d9e7fe94961e22cb216ecc600..33e05be5bd1838eca22d96abe55dc2407de3d9dd 100644 (file)
--- 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;
 }
 

diff --git a/gcc/testsuite/gfortran.dg/deferred_character_36.f90 b/gcc/testsuite/gfortran.dg/deferred_character_36.f90
new file mode 100644 (file)
index 0000000..65f2464
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_36.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+!
+! Test the fix for PR93833, which ICEd as shown.
+!
+! Contributed by Gerhard Steinmetz  <gscfq@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