[patch] fix PR libfortran/23321

[Thomas Koenig]

:ADDPATCH libfortran:

This fixes PR 23321.  Regression-tested on mainline.  OK for
mainlien (and 4.0, once regression-testing has been completed)?

	Thomas

2005-08-16  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/23321
	* io/transfer.c:  Check for a too-large record number.

2005-08-16  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/23321
	* gfortran.dg/direct_io_4.f90:  New test case.
-------------- next part --------------
Index: transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.52
diff -c -p -r1.52 transfer.c
*** transfer.c	9 Aug 2005 01:56:04 -0000	1.52
--- transfer.c	16 Aug 2005 20:00:22 -0000
*************** data_transfer_init (int read_flag)
*** 1163,1168 ****
--- 1163,1178 ----
        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)
-------------- next part --------------
! { 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