[patch, libgfortran] PR24224 Generalized internal array IO not implemented.

[Jerry DeLisle]

Jerry DeLisle wrote:
> Paul Thomas wrote:

>> Now for the question: I wonder if this behaves as it should?
>>
>> [prt@localhost mytests]# cat arrayio_test.f90
>> character*4, dimension(8) :: abuf = (/"0123","4567","89AB","CDEF", &
>>  "0123","4567","89AB","CDEF"/)
>> character*4, dimension(2,4) :: buf
>> character*8 :: a
>> equivalence (buf,abuf)
>> read(buf(2, 1:3:2), '(a)') a
>> print *,a
>> end
>>
>> [prt@localhost mytests]# ./a.out
>> 456789AB
>>
>> g95 and ifc yield
>>
>> 4567          ie. the end of record is acted upon.
>>
>> Paul
>>
> 
> I will study this a bit.  Without looking yet, I think s_alloc_r_at is 
> not catching the end of record.  This may be a new bug.  (I wonder if 
> this really should be a run time error, trying to read past end of record)
> 
> I will report back on this.
> 

I have found it and it is another bug.  In read_block there is code to catch 
this condition and modify the length of the read, but it is put after the code 
that calls sf_read and it is never reached.

By moving the sf_read code segment after this check, we get the correct answer. 
  Regtesting this was successful.

I will make sure we get this into a new test case.  (I am working the cleanups 
Paul asked for now, just wanted to get this little bugaboo out of the way.)

Should I create a separate PR for this?

See the corrected code below:

Regards,

Jerry

read_block (int *length)
{
   char *source;
   int nread;

   /* This if block was placed after the one indicated below */

   if (current_unit->bytes_left < *length)
     {
       if (current_unit->flags.pad == PAD_NO)
	{
	  generate_error (ERROR_EOR, NULL); /* Not enough data left.  */
	  return NULL;
	}

       *length = current_unit->bytes_left;
     }

   /* The following if block was executing first and returning with read_sf */

   if (current_unit->flags.form == FORM_FORMATTED &&
       current_unit->flags.access == ACCESS_SEQUENTIAL)
     return read_sf (length);	/* Special case.  */