gfortran-4.1.0 file io bug fix

[Georgy Salnikov]

Dear Jerry, dear Steve,

It's me again, this time dealing with another Fortran file IO bug found in
the version gcc-4.1.0.

The file IO in gfortran-4.1.0 is now good fast, and backspace after
end-of-file condition I reported in november 2005 is now working correctly.

The problem I'd like to report now is following.

One creates a sequential unformatted file, writes several records with
various data there, and then repeatedly rewinds the file and reads these
data back again and again.

If all the records are short enough, the IO will be buffered inside the
libgfortran runtime (for the reason of speed), and this works correctly.

If the records are much longer than the buffer size (8K at the moment), the
IO requests will be done directly via libc's read/write/lseek. This seems
also to work correctly, although I am not 100% sure.

My program writes firstly a few short records, one of them containing the
size of an array which is to be written next. All these records are written
buffered. Then a rather long array is written (unbuffered because of its
length). Then again several short records, and again a long array (of
different size). And so on.

While writing all the information is written correctly, I have proven, the
file contents is right.

After rewinding the first short records and the first long array are read
correctly. But immediately after reading the long array the file pointer
s->logical_offset (libgfortran/io/unix.c) gets corrupted. As the result, the
following short records are filled with garbage, and while trying to read
the array of wrong length the program usually gets SIGSEGV or something like
this.

The following patch against gcc-4.1.0 corrects this wrong behaviour:

diff -Naur gcc-4.1.0.orig/libgfortran/io/unix.c gcc-4.1.0/libgfortran/io/unix.c
--- gcc-4.1.0.orig/libgfortran/io/unix.c	2006-02-15 02:21:15.000000000 +0600
+++ gcc-4.1.0/libgfortran/io/unix.c	2006-03-09 16:31:44.000000000 +0600
@@ -224,8 +224,8 @@
 inline static void
 reset_stream (unix_stream * s, size_t bytes_rw)
 {
-  s->physical_offset += bytes_rw;
-  s->logical_offset = s->physical_offset;
+  s->logical_offset += bytes_rw;
+  s->physical_offset = s->logical_offset;
   if (s->file_length != -1 && s->physical_offset > s->file_length)
     s->file_length = s->physical_offset;
 }

The following sample program demonstrates the bug. It runs correctly when
compiled, let's say, with g77-3.3.6, wrong when compiled with unpatched
gfortran-4.1.0, and again correctly after patching it as shown above.

With kind regards,
Georgy Salnikov, Novosibirsk.

      parameter (isize=50000)
      character*80 name
      integer array(isize)
      call getarg (1, name)
      print *, 'opening ', name
      open (unit=7, file=name, status='new', access='sequential',
     *form='unformatted', err=100)
      print *, 'ok'
      do 1 i=1,isize
 1       array(i) = i
      print *, 'writing ', name
      write (unit=7, err=100) name
      print *, 'writing ', isize
      write (unit=7, err=100) isize
      print *, 'ok'
      print *, 'writing ', array(1), ' ... ', array(isize)
      call wr (array, isize, iret)
      if (iret.eq.0) then
         print *, 'ok'
      else
         print *, 'bad'
      endif
      do 2 i=1,isize
 2       array(i) = isize-i
      print *, 'writing ', name
      write (unit=7, err=100) name
      print *, 'writing ', isize
      write (unit=7, err=100) isize
      print *, 'ok'
      print *, 'writing ', array(1), ' ... ', array(isize)
      call wr (array, isize, iret)
      if (iret.eq.0) then
         print *, 'ok'
      else
         print *, 'bad'
      endif
      print *, 'rewinding'
      rewind (unit=7, err=100)
      print *, 'ok'
      print *, 'reading name'
      read (unit=7, err=100) name
      print *, 'name ', name, ' ok'
      print *, 'reading nsize'
      read (unit=7, err=100) nsize
      print *, 'nsize ', nsize, ' ok'
      do 3 i=1,nsize
 3       array(i) = 0
      print *, 'reading array'
      call rd (array, nsize, iret)
      if (iret.eq.0) then
         print *, 'array ', array(1), ' ... ', array(nsize), ' ok'
      else
         print *, 'bad'
      endif
      print *, 'reading name'
      read (unit=7, err=100) name
      print *, 'name ', name, ' ok'
      print *, 'reading nsize'
      read (unit=7, err=100) nsize
      print *, 'nsize ', nsize, ' ok'
      do 4 i=1,nsize
 4       array(i) = 0
      print *, 'reading array'
      call rd (array, nsize, iret)
      if (iret.eq.0) then
         print *, 'array ', array(1), ' ... ', array(nsize), ' ok'
      else
         print *, 'bad'
      endif
      stop
 100  print *, 'bad'
      stop
      end
      subroutine rd (a, n, iret)
      integer a(n)
      read (unit=7, err=100) a
      iret = 0
      return
 100  iret = 1
      return
      end
      subroutine wr (a, n, iret)
      integer a(n)
      write (unit=7, err=100) a
      iret = 0
      return
 100  iret = 1
      return
      end

_______________________________________________________________________________

Georgy Salnikov
NMR Group
Novosibirsk Institute of Organic Chemistry
Lavrentjeva, 9, 630090 Novosibirsk, Russia
Tel.   +7-383-3307864   +7-383-3331456
Fax                     +7-383-3331456
Email   sge@nmr.nioch.nsc.ru
_______________________________________________________________________________