OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/48890 ([F95] Wrong length of a character component of named constant derived-type)

Browse Source 
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.

From-SVN: r257856
This commit is contained in:
Thomas Koenig 2018-02-20 18:57:34 +00:00
parent 5a54a15e30
commit 04946c6b90
4 changed files with 70 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -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

32
gcc/fortran/primary.c
View File

@ -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;

6
gcc/testsuite/ChangeLog
View File

@ -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

24
gcc/testsuite/gfortran.dg/structure_constructor_14.f90 Normal file
View File

@ -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