diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a8ecc418f46..0c63f99b527 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-04-04 Tobias Burnus + + PR fortran/56810 + * gfortran.dg/read_repeat_2.f90: New. + 2013-04-04 Richard Biener PR tree-optimization/56837 diff --git a/gcc/testsuite/gfortran.dg/read_repeat_2.f90 b/gcc/testsuite/gfortran.dg/read_repeat_2.f90 new file mode 100644 index 00000000000..4b8659e5f34 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/read_repeat_2.f90 @@ -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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index fe9ae95a855..a963d45d2f1 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,8 @@ +2013-04-04 Tobias Burnus + + PR fortran/56810 + * io/list_read.c (check_type): Fix kind checking for COMPLEX. + 2013-04-01 Jerry DeLisle PR libfortran/56660 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 0693e50f4aa..b29fdcd2306 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -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;