[patch, fortran] Fix character length in constructors

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

when putting in a seemingly innocent simplification for PR 56342,
I caused a regression in PR 82823, in PACK. The root cause of
this one turned out to be PR 48890, in which structure
constructors containing characters were not handled correctly
if the lengths did not match.

The attached patch fixes that.

Regression-tested. OK for trunk?

Regards

	Thomas

2018-02-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

        PR fortran/48890
        PR fortran/83823
        * primary.c (gfc_convert_to_structure_constructor):
        For a constant string constructor, make sure the length
        is correct.

2018-02-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

        PR fortran/48890
        PR fortran/83823
        * gfortran.dg/structure_constructor_14.f90: New test.

! { dg-do  run }
! PR 48890, PR 83823
! Test fix for wrong length in parameters. Original test cases
! by mhp77 (a) gmx.at and Harald Anlauf.

program gfcbug145
  implicit none
  type t_obstyp
    character(len=8) :: name
  end type t_obstyp
  type (t_obstyp) ,parameter :: obstyp(*)= &
     [ t_obstyp ('SYNOP' ), &
       t_obstyp ('DRIBU' ), &
       t_obstyp ('TEMP'  ), &
       t_obstyp ('RADAR' )  ]
  logical :: mask(size(obstyp)) = .true.
  character(len=100) :: line
  type (t_obstyp), parameter :: x = t_obstyp('asdf')

  write(line,'(20(a8,:,"|"))') pack (obstyp% name, mask)
  if (line /= 'SYNOP   |DRIBU   |TEMP    |RADAR') call abort
  write (line,'("|",A,"|")') x
  if (line /= "|asdf    |") call abort
end program gfcbug145

Index: primary.c
===================================================================
--- primary.c	(Revision 257788)
+++ primary.c	(Arbeitskopie)
@@ -2879,6 +2879,38 @@ gfc_convert_to_structure_constructor (gfc_expr *e,
       if (!this_comp)
 	goto cleanup;
 
+      /* For a constant string constructor, make sure the length is correct;
+	 truncate of fill with blanks if needed.  */
+      if (this_comp->ts.type == BT_CHARACTER && !this_comp->attr.allocatable
+	  && this_comp->ts.u.cl && this_comp->ts.u.cl->length
+	  && this_comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && actual->expr->expr_type == EXPR_CONSTANT)
+	{
+	  ptrdiff_t c, e;
+	  c = mpz_get_si (this_comp->ts.u.cl->length->value.integer);
+	  e = actual->expr->value.character.length;
+
+	  if (c != e)
+	    {
+	      ptrdiff_t i, to;
+	      gfc_char_t *dest;
+	      dest = gfc_get_wide_string (c + 1);
+
+	      to = e < c ? e : c;
+	      for (i = 0; i < to; i++)
+		dest[i] = actual->expr->value.character.string[i];
+	      
+	      for (i = e; i < c; i++)
+		dest[i] = ' ';
+
+	      dest[c] = '\0';
+	      free (actual->expr->value.character.string);
+
+	      actual->expr->value.character.length = c;
+	      actual->expr->value.character.string = dest;
+	    }
+	}
+
       comp_tail->val = actual->expr;
       if (actual->expr != NULL)
 	comp_tail->where = actual->expr->where;