[gfortran] Patch for PR14904 - NQUIRE returns incorrect LASTREC

[Bud Davis <bdavis9659 at comcast dot net>]

When more than one record is written to a direct access formatted
unit with one write statement, inquire should increment LASTREC to
reflect the number of records written.  Currently, it assumes one
write = one record written, which is wrong.


The fix is simple, update current_unit->last_record with the actual
number of records written instead of incrementing.


no additional failures on i686/gnu/linux.


This is the 4th bug found from NIST test FM921.FOR, and it still fails a
couple of test sections...is the supply of bugs infinite ?


--bud

Index: gcc/gcc/testsuite/ChangeLog.tree-ssa
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/Attic/ChangeLog.tree-ssa,v
retrieving revision 1.1.2.218
diff -c -3 -p -r1.1.2.218 ChangeLog.tree-ssa
*** gcc/gcc/testsuite/ChangeLog.tree-ssa        8 Apr 2004 15:02:47 -0000       1.1.2.218
--- gcc/gcc/testsuite/ChangeLog.tree-ssa        10 Apr 2004 03:01:56 -0000
***************
*** 1,3 ****
--- 1,8 ----
+ 2004-04-09  Bud Davis  <bdavis9659@comcast.net>
+
+       PR gfortran/14904
+       * gfortran.fortran-torture/execute/inquire_4.f90: New test.
+
  2004-04-08  Brian Booth  <bbooth@redhat.com>
   
        * gcc.dg/tree-ssa/20040408-1.c: New test.
Index: gcc/gcc/testsuite/gfortran.fortran-torture/execute/inquire_4.f90
===================================================================
RCS file: gcc/gcc/testsuite/gfortran.fortran-torture/execute/inquire_4.f90
diff -N gcc/gcc/testsuite/gfortran.fortran-torture/execute/inquire_4.f90
*** /dev/null   1 Jan 1970 00:00:00 -0000
--- gcc/gcc/testsuite/gfortran.fortran-torture/execute/inquire_4.f90    10 Apr 2004 03:02:08 -0000
***************
*** 0 ****
--- 1,20 ----
+ ! pr 14904
+ ! inquire lastrec not correct when two records written
+ ! with one write statement
+        OPEN(UNIT=10,ACCESS='DIRECT',FORM='FORMATTED',RECL=120)
+  100   FORMAT(I4)
+        WRITE(UNIT=10,REC=1,FMT=100)1
+        INQUIRE(UNIT=10,NEXTREC=J)
+        IF (J.NE.2) THEN
+            PRINT*,'NEXTREC RETURNED ',J,' EXPECTED 2'
+            CALL ABORT
+        ENDIF
+  200   FORMAT(I4,/,I4)
+        WRITE(UNIT=10,REC=2,FMT=200)2,3
+        INQUIRE(UNIT=10,NEXTREC=J)
+        IF (J.NE.4) THEN
+            PRINT*,'NEXTREC RETURNED ',J,' EXPECTED 4'
+            CALL ABORT
+        ENDIF
+        END
+
Index: gcc/libgfortran/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Attic/ChangeLog,v
retrieving revision 1.1.2.41
diff -c -3 -p -r1.1.2.41 ChangeLog
*** gcc/libgfortran/ChangeLog   4 Apr 2004 03:06:56 -0000       1.1.2.41
--- gcc/libgfortran/ChangeLog   10 Apr 2004 03:02:12 -0000
***************
*** 1,3 ****
--- 1,10 ----
+ 2004-04-09  Bud Davis  <bdavis9659@comcast.net>
+
+       PR gfortran/14904
+       * io/transfer.c (next_record): Update last_record when
+       more than one record is written to a direct access file
+       with one write statement.
+
  2004-04-03  Bud Davis  <bdavis9659@comcast.net>
   
        PR gfortran/14762
Index: gcc/libgfortran/io/transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/transfer.c,v
retrieving revision 1.1.2.12
diff -c -3 -p -r1.1.2.12 transfer.c
*** gcc/libgfortran/io/transfer.c       4 Apr 2004 03:06:57 -0000       1.1.2.12
--- gcc/libgfortran/io/transfer.c       10 Apr 2004 03:02:12 -0000
*************** next_record (int done)
*** 1296,1302 ****
   
    current_unit->current_record = 0;
    if (current_unit->flags.access == ACCESS_DIRECT)
!     current_unit->last_record = ioparm.rec;
    else
      current_unit->last_record++;
   
--- 1296,1303 ----
   
    current_unit->current_record = 0;
    if (current_unit->flags.access == ACCESS_DIRECT)
!     current_unit->last_record = file_position (current_unit->s)
!                                / current_unit->recl;
    else
      current_unit->last_record++;