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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a8ecc41..0c63f99 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/read_repeat_2.f90 b/gcc/testsuite/gfortran.dg/read_repeat_2.f90
new file mode 100644 (file)
index 0000000..4b8659e
--- /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 fe9ae95..a963d45 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 0693e50..b29fdcd 100644 (file)
--- 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;