| Message ID | 515B1336.2070800@net-b.de |
|---|---|
| State | New |
| Headers | show |
Le 02/04/2013 19:19, Tobias Burnus a écrit : > { > 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 > + : type == BT_COMPLEX, thinko? > + type_name (dtp->u.p.saved_type), kind, > dtp->u.p.item_count); > generate_error (&dtp->common, LIBERROR_READ_VALUE, message); > return 1;
Am 04.04.2013 00:27, schrieb Mikael Morin: > Le 02/04/2013 19:19, Tobias Burnus a écrit : >> { >> 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 >> + : type == BT_COMPLEX, > thinko? Rather "copy&pasto": Obviously, it should be ": dtp->u.p.saved_length," in the last line. OK with that changed (after regtesting)? Tobias
Le 04/04/2013 00:56, Tobias Burnus a écrit : > Am 04.04.2013 00:27, schrieb Mikael Morin: >> Le 02/04/2013 19:19, Tobias Burnus a écrit : >>> { >>> 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 >>> + : type == BT_COMPLEX, >> thinko? > > Rather "copy&pasto": Obviously, it should be ": dtp->u.p.saved_length," > in the last line. > > OK with that changed (after regtesting)? > Yes.
2013-04-02 Tobias Burnus <burnus@net-b.de> PR fortran/56810 * io/list_read.c (check_type): Fix kind checking for COMPLEX. 2013-04-02 Tobias Burnus <burnus@net-b.de> PR fortran/56810 * gfortran.dg/read_repeat_2.f90: New. diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 0693e50..da92ad3 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 + : type == BT_COMPLEX, + type_name (dtp->u.p.saved_type), kind, dtp->u.p.item_count); generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; --- /dev/null 2013-04-02 09:26:12.399063163 +0200 +++ gcc/gcc/testsuite/gfortran.dg/read_repeat_2.f90 2013-04-02 19:01:36.254797196 +0200 @@ -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