aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/io
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2013-04-04 13:24:15 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2013-04-04 13:24:15 +0200
commit71879a86efd6404ef36a0493b900868f10808646 (patch)
treedf5329c928c8cf6fa8d1e32ec60361ab9daeeac9 /libgfortran/io
parentf1bf4f3afb21fdb807c050693ac9da523e64f2a4 (diff)
downloadgcc-71879a86efd6404ef36a0493b900868f10808646.zip
gcc-71879a86efd6404ef36a0493b900868f10808646.tar.gz
gcc-71879a86efd6404ef36a0493b900868f10808646.tar.bz2
re PR libfortran/56810 (record-repeat fails kind check on complex read)
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
Diffstat (limited to 'libgfortran/io')
-rw-r--r--libgfortran/io/list_read.c9
1 files changed, 6 insertions, 3 deletions
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 0693e50..b29fdcd 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;