This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR56810 - fix I/O READ of COMPLEX with repeat count
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Tue, 02 Apr 2013 19:19:50 +0200
- Subject: [Patch, Fortran] PR56810 - fix I/O READ of COMPLEX with repeat count
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
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