2005-09-04 Thomas Koenig <Thomas.Koenig@online.de>

	PR libfortran/23321
	* io/transfer.c(data_transfer_init):  Check for a too-large
	record number.  Return if sseek failed.

2005-09-04  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/23321
	* gfortran.dg/direct_io_4.f90:  New test case.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103835 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d9a5e53..0988d1c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2005-09-04  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/23321
+       * gfortran.dg/direct_io_4.f90:  New test case.
+
 2005-09-04  Andrew Pinski  <pinskia@physics.uc.edu>
             Rasmus Hahn  <rassahah@neofonie.de>
 

diff --git a/gcc/testsuite/gfortran.dg/direct_io_4.f90 b/gcc/testsuite/gfortran.dg/direct_io_4.f90
new file mode 100644 (file)
index 0000000..0507967
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_4.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! PR 23321 : Running off the end of a file was not detected with direct I/O.
+program main
+  implicit none
+  integer(kind=1) :: a, b
+  integer :: ios, i
+
+  a = 42
+  open (unit=10,status="scratch",recl=1,access="direct")
+  write(10,rec=1) a
+
+  read (10,rec=2, iostat=ios) b
+  if (ios == 0) call abort
+
+  read (10, rec=82641, iostat=ios) b      ! This used to cause a segfault
+  if (ios == 0) call abort
+
+  read(10, rec=1, iostat=ios) b
+  if (ios /= 0) call abort 
+  if (a /= b) call abort
+
+end program main

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 02df5fd..2023979 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,9 @@
+2005-09-04  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/23321
+       * io/transfer.c(data_transfer_init):  Check for a too-large
+       record number.  Return if sseek failed.
+
 2005-09-03  Jakub Jelinek  <jakub@redhat.com>
 
        * io/read.c (read_x): Take int argument instead of fnode * and

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 7449f02..59eb22d 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1160,10 +1160,23 @@ data_transfer_init (int read_flag)
       if (g.mode == READING && current_unit->mode  == WRITING)
         flush(current_unit->s);
 
+      /* Check whether the record exists to be read.  Only
+        a partial record needs to exist.  */
+
+      if (g.mode == READING && (ioparm.rec -1)
+         * current_unit->recl >= file_length (current_unit->s))
+       {
+         generate_error (ERROR_BAD_OPTION, "Non-existing record number");
+         return;
+       }
+
       /* Position the file.  */
       if (sseek (current_unit->s,
               (ioparm.rec - 1) * current_unit->recl) == FAILURE)
-       generate_error (ERROR_OS, NULL);
+       {
+         generate_error (ERROR_OS, NULL);
+         return;
+       }
     }
 
   /* Overwriting an existing sequential file ?