Patchwork [Fortran] PR56810 - fix I/O READ of COMPLEX with repeat count

login
register
mail settings
Submitter Tobias Burnus
Date April 2, 2013, 5:19 p.m.
Message ID <515B1336.2070800@net-b.de>
Download mbox | patch
Permalink /patch/233114/
State New
Headers show

Comments

Tobias Burnus - April 2, 2013, 5:19 p.m.
Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
Mikael Morin - April 3, 2013, 10:27 p.m.
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;
Tobias Burnus - April 3, 2013, 10:56 p.m.
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
Mikael Morin - April 4, 2013, 10:28 a.m.
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.

Patch

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