aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJerry DeLisle <jvdelisle@gcc.gnu.org>2024-03-26 16:44:17 -0700
committerJerry DeLisle <jvdelisle@gcc.gnu.org>2024-03-26 17:13:51 -0700
commit41e767c482fc903ca5d54014b034c7526dbf8f1c (patch)
tree0414ba62d07a5e77d797ce128f96d20e06d69a62
parentfb1d50e1f6e07c146999b1b773043c140fdc72b5 (diff)
downloadgcc-41e767c482fc903ca5d54014b034c7526dbf8f1c.zip
gcc-41e767c482fc903ca5d54014b034c7526dbf8f1c.tar.gz
gcc-41e767c482fc903ca5d54014b034c7526dbf8f1c.tar.bz2
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.
-rw-r--r--gcc/testsuite/gfortran.dg/endfile_5.f9030
-rw-r--r--libgfortran/io/file_pos.c1
2 files changed, 30 insertions, 1 deletions
diff --git a/gcc/testsuite/gfortran.dg/endfile_5.f90 b/gcc/testsuite/gfortran.dg/endfile_5.f90
new file mode 100644
index 0000000..90eaa6b
--- /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 2bc05b2..d169961 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);