re PR libfortran/23321 (Direct unformatted read beyond EOF cores)

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.

From-SVN: r103835

gcc/testsuite/ChangeLog

+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>
 

gcc/testsuite/gfortran.dg/direct_io_4.f90

+! { 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

libgfortran/ChangeLog

+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

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 ?