[gcc r14-9681] libgfortran: Fix file position after ENDFILE statement.

[Jerry DeLisle via Gcc-cvs]

https://gcc.gnu.org/g:41e767c482fc903ca5d54014b034c7526dbf8f1c

commit r14-9681-g41e767c482fc903ca5d54014b034c7526dbf8f1c
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date:   Tue Mar 26 16:44:17 2024 -0700

    libgfortran: Fix file position after ENDFILE statement.
    
            PR libfortran/107031
    
    libgfortran/ChangeLog:
    
            * io/file_pos.c (st_endfile): Remove call to next_record().
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/endfile_5.f90: New test.

Diff:
---
 gcc/testsuite/gfortran.dg/endfile_5.f90 | 30 ++++++++++++++++++++++++++++++
 libgfortran/io/file_pos.c               |  1 -
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/gcc/testsuite/gfortran.dg/endfile_5.f90 
b/gcc/testsuite/gfortran.dg/endfile_5.f90
new file mode 100644
index 00000000000..90eaa6b2e5b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/endfile_5.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! PR107031 Check that endfile truncates at end of record 5.
+program test_truncate
+    integer :: num_rec, tmp, i, nr, j
+    open(10, file="in.dat", action='readwrite')
+
+    do i=1,10
+      write(10, *) i
+    end do
+
+    rewind (10)
+
+    num_rec = 5
+    i = 1
+    ioerr = 0
+    do while (i <= num_rec .and. ioerr == 0)
+        read(10, *, iostat=ioerr) tmp
+        i = i + 1
+    enddo
+    endfile(10)
+    rewind (10)
+    i = 0
+    ioerr = 0
+    do while (i <= num_rec + 1 .and. ioerr == 0)
+      read(10, *, iostat=ioerr) j
+      i = i + 1
+    end do
+    close(10, status='delete')
+    if (i - 1 /= 5) stop 1
+end program test_truncate
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 2bc05b293f8..d169961f997 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -352,7 +352,6 @@ st_endfile (st_parameter_filepos *fpp)
          dtp.common = fpp->common;
          memset (&dtp.u.p, 0, sizeof (dtp.u.p));
          dtp.u.p.current_unit = u;
-         next_record (&dtp, 1);
        }
 
       unit_truncate (u, stell (u->s), &fpp->common);