procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/56810 (record-repeat fails kind check on complex read)

Browse source 
2013-04-04  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56810
        * io/list_read.c (check_type): Fix kind checking for COMPLEX.

2013-04-04  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56810
        * gfortran.dg/read_repeat_2.f90: New.

From-SVN: r197479
This commit is contained in:
Tobias Burnus 2013-04-04 13:24:15 +02:00 • committed by Tobias Burnus
parent f1bf4f3afb
commit 71879a86ef
4 changed files with 35 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2013-04-04 Tobias Burnus <burnus@net-b.de>
PR fortran/56810
* gfortran.dg/read_repeat_2.f90: New.
2013-04-04 Richard Biener <rguenther@suse.de>
PR tree-optimization/56837

19
gcc/testsuite/gfortran.dg/read_repeat_2.f90 Normal file
View file

@ -0,0 +1,19 @@
! { dg-do run }
!
! PR fortran/56810
!
! Contributed by Jonathan Hogg
!
program test
implicit none
integer :: i
complex :: a(4)
open (99, status='scratch')
write (99, *) '4*(1.0,2.0)'
rewind (99)
read (99,*) a(:)
close (99)
if (any (a /= cmplx (1.0,2.0))) call abort()
end program test

5
libgfortran/ChangeLog
View file

@ -1,3 +1,8 @@
2013-04-04 Tobias Burnus <burnus@net-b.de>
PR fortran/56810
* io/list_read.c (check_type): Fix kind checking for COMPLEX.
2013-04-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/56660

9
libgfortran/io/list_read.c
View file

@ -1784,7 +1784,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
compatible. Returns nonzero if incompatible. */
static int
check_type (st_parameter_dt *dtp, bt type, int len)
check_type (st_parameter_dt *dtp, bt type, int kind)
{
char message[MSGLEN];
@ -1801,11 +1801,14 @@ check_type (st_parameter_dt *dtp, bt type, int len)
if (dtp->u.p.saved_type == BT_UNKNOWN || dtp->u.p.saved_type == BT_CHARACTER)
return 0;
if (dtp->u.p.saved_length != len)
if ((type != BT_COMPLEX && dtp->u.p.saved_length != kind)
|| (type == BT_COMPLEX && dtp->u.p.saved_length != kind*2))
{
snprintf (message, MSGLEN,
"Read kind %d %s where kind %d is required for item %d",
dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len,
type == BT_COMPLEX ? dtp->u.p.saved_length / 2
: dtp->u.p.saved_length,
type_name (dtp->u.p.saved_type), kind,
dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1;