2018-02-20 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-20  Thomas Koenig  <tkoenig@gcc.gnu.org>

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



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@257856 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 70 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e3818ab6a92..d6d66c5e3f3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2018-02-20  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  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/83344
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 9e6a8fe0d80..d889ed10ac3 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2879,6 +2879,38 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
       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 = gfc_mpz_get_hwi (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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index de9cd420e9e..6351dd56db7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2018-02-20  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/48890
+	PR fortran/83823
+	* gfortran.dg/structure_constructor_14.f90: New test.
+
 2018-02-20  Jeff Law  <law@redhat.com>
 
         PR middle-end/82123
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_14.f90 b/gcc/testsuite/gfortran.dg/structure_constructor_14.f90
new file mode 100644
index 00000000000..b8892063434
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_14.f90
@@ -0,0 +1,24 @@
+! { 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') STOP 1
+  write (line,'("|",A,"|")') x
+  if (line /= "|asdf    |") STOP 1
+end program gfcbug145