From 04946c6b905572f35f06de34460d20f05203a033 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Tue, 20 Feb 2018 18:57:34 +0000 Subject: [PATCH] re PR fortran/48890 ([F95] Wrong length of a character component of named constant derived-type) 2018-02-20 Thomas Koenig 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 PR fortran/48890 PR fortran/83823 * gfortran.dg/structure_constructor_14.f90: New test. From-SVN: r257856 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/primary.c | 32 +++++++++++++++++++ gcc/testsuite/ChangeLog | 6 ++++ .../gfortran.dg/structure_constructor_14.f90 | 24 ++++++++++++++ 4 files changed, 70 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/structure_constructor_14.f90 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 + + 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 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 + + PR fortran/48890 + PR fortran/83823 + * gfortran.dg/structure_constructor_14.f90: New test. + 2018-02-20 Jeff Law 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 -- 2.30.2