[Patch, fortran] PR68155 - ICE on initializing character array in type (len_lhs <> len_rhs)

[Patch, fortran] PR68155 - ICE on initializing character array in type (len_lhs <> len_rhs)

[Paul Richard Thomas]

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

Hi All,

This is a straightforward patch that is adequately explained by the ChangeLog.

Regtests fine - OK for trunk?

Cheers

Paul

Fortran: Pad mismatched charlens in component initializers [PR68155]

2023-09-20  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
PR fortran/68155
* decl.cc (fix_initializer_charlen): New function broken out of
add_init_expr_to_sym.
(add_init_expr_to_sym, build_struct): Call the new function.

gcc/testsuite/
PR fortran/68155
* gfortran.dg/pr68155.f90: New test.

[-- Attachment #2: fix.diff --]
[-- Type: text/x-patch, Size: 3768 bytes --]

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 8182ef29f43..4a3c5b86de0 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1960,6 +1960,45 @@ gfc_free_enum_history (void)
 }
 
 
+/* Function to fix initializer character length if the length of the
+   symbol or component is constant.  */
+
+static bool
+fix_initializer_charlen (gfc_typespec *ts, gfc_expr *init)
+{
+  if (!gfc_specification_expr (ts->u.cl->length))
+    return false;
+
+  int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+
+  /* resolve_charlen will complain later on if the length
+     is too large.  Just skip the initialization in that case.  */
+  if (mpz_cmp (ts->u.cl->length->value.integer,
+	       gfc_integer_kinds[k].huge) <= 0)
+    {
+      HOST_WIDE_INT len
+		= gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
+
+      if (init->expr_type == EXPR_CONSTANT)
+	gfc_set_constant_character_len (len, init, -1);
+      else if (init->expr_type == EXPR_ARRAY)
+	{
+	  gfc_constructor *cons;
+
+	  /* Build a new charlen to prevent simplification from
+	     deleting the length before it is resolved.  */
+	  init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+	  init->ts.u.cl->length = gfc_copy_expr (ts->u.cl->length);
+	  cons = gfc_constructor_first (init->value.constructor);
+	  for (; cons; cons = gfc_constructor_next (cons))
+	    gfc_set_constant_character_len (len, cons->expr, -1);
+	}
+    }
+
+  return true;
+}
+
+
 /* Function called by variable_decl() that adds an initialization
    expression to a symbol.  */
 
@@ -2073,40 +2112,10 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
 				gfc_copy_expr (init->ts.u.cl->length);
 		}
 	    }
-	  /* Update initializer character length according symbol.  */
-	  else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
-	    {
-	      if (!gfc_specification_expr (sym->ts.u.cl->length))
-		return false;
-
-	      int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind,
-					 false);
-	      /* resolve_charlen will complain later on if the length
-		 is too large.  Just skeep the initialization in that case.  */
-	      if (mpz_cmp (sym->ts.u.cl->length->value.integer,
-			   gfc_integer_kinds[k].huge) <= 0)
-		{
-		  HOST_WIDE_INT len
-		    = gfc_mpz_get_hwi (sym->ts.u.cl->length->value.integer);
-
-		  if (init->expr_type == EXPR_CONSTANT)
-		    gfc_set_constant_character_len (len, init, -1);
-		  else if (init->expr_type == EXPR_ARRAY)
-		    {
-		      gfc_constructor *c;
-
-		      /* Build a new charlen to prevent simplification from
-			 deleting the length before it is resolved.  */
-		      init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
-		      init->ts.u.cl->length
-			= gfc_copy_expr (sym->ts.u.cl->length);
-
-		      for (c = gfc_constructor_first (init->value.constructor);
-			   c; c = gfc_constructor_next (c))
-			gfc_set_constant_character_len (len, c->expr, -1);
-		    }
-		}
-	    }
+	  /* Update initializer character length according to symbol.  */
+	  else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
+		   && !fix_initializer_charlen (&sym->ts, init))
+	    return false;
 	}
 
       if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension && sym->as
@@ -2369,6 +2378,13 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
   c->initializer = *init;
   *init = NULL;
 
+  /* Update initializer character length according to component.  */
+  if (c->ts.type == BT_CHARACTER && c->ts.u.cl->length
+      && c->ts.u.cl->length->expr_type == EXPR_CONSTANT
+      && c->initializer && c->initializer->ts.type == BT_CHARACTER
+      && !fix_initializer_charlen (&c->ts, c->initializer))
+    return false;
+
   c->as = *as;
   if (c->as != NULL)
     {

[-- Attachment #3: pr68155.f90 --]
[-- Type: text/x-fortran, Size: 1172 bytes --]

! { dg-do run }
!
! Fix for PR68155 in which initializers of constant length, character
! components of derived types were not being padded if they were too short.
! Originally, mismatched lengths caused ICEs. This seems to have been fixed
! in 9-branch.
!
! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
!
program p
  implicit none
  type t
    character(3) :: c1(2) = [                 'b', 'c']          ! OK
    character(3) :: c2(2) = [ character(1) :: 'b', 'c'] // ""    ! OK
    character(3) :: c3(2) = [                 'b', 'c'] // ""    ! was not padded
    character(3) :: c4(2) = [                 '' , '' ] // ""    ! was not padded
    character(3) :: c5(2) = [                 'b', 'c'] // 'a'   ! was not padded
    character(3) :: c6(2) = [                 'b', 'c'] // 'ax'  ! OK
    character(3) :: c7(2) = [                 'b', 'c'] // 'axy' ! OK trimmed
  end type t
  type(t)      :: z
  if (z%c1(2) .ne. 'c  ') stop 1
  if (z%c2(2) .ne. 'c  ') stop 2
  if (z%c3(2) .ne. 'c  ') stop 3
  if (z%c4(2) .ne. '   ') stop 4
  if (z%c5(2) .ne. 'ca ') stop 5
  if (z%c6(2) .ne. 'cax') stop 6
  if (z%c7(2) .ne. 'cax') stop 7
end

Re: [Patch, fortran] PR68155 - ICE on initializing character array in type (len_lhs <> len_rhs)

[Harald Anlauf]

Hi Paul,

On 9/20/23 09:03, Paul Richard Thomas wrote:
> Hi All,
>
> This is a straightforward patch that is adequately explained by the ChangeLog.
>
> Regtests fine - OK for trunk?

this looks good to me.  OK for trunk.

As it is an almost obvious fix for sort of wrong code, I'd consider
it backportable if you have intentions in that direction.

Thanks,
Harald

> Cheers
>
> Paul
>
> Fortran: Pad mismatched charlens in component initializers [PR68155]
>
> 2023-09-20  Paul Thomas  <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/68155
> * decl.cc (fix_initializer_charlen): New function broken out of
> add_init_expr_to_sym.
> (add_init_expr_to_sym, build_struct): Call the new function.
>
> gcc/testsuite/
> PR fortran/68155
> * gfortran.dg/pr68155.f90: New test.