[patch, libgfortran] PR25598 Fortran runtime error: Invalid argument

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

This bug was actually two bugs.  One in unformatted backspace and one in 
st_backspace.  So I have submitted here two test cases only slightly different 
from each other.

The first problem was that BACKSPACE was not clearing the units bytes_left count 
so that on the next BACKSPACE it would calculate a new file position based on an 
erroneous bytes left and the seek to a negative value would throw an error.

The second is for unformatted_backspace, the calculation of the 'new' file 
position goes negative also resulting in an error on the seek.

These errors only occur on repeated BACKSPACE invocations that hit the beginning 
of the file.

Regression tested, NIST tested, LAPACK tested.

OK for 4.2 and 4.1 in a few days?

Regards,

Jerry

2006-01-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/25598
	* io/file_pos.c (unformatted_backspace): Assure the new file position
	to seek is not less than zero.
	(st_backspace): Set unit bytes_left to zero.
	* io/transfer.c (next_record_r): Fix line lengths, no functional change.



Index: io/file_pos.c
===================================================================
*** io/file_pos.c	(revision 109173)
--- io/file_pos.c	(working copy)
*************** unformatted_backspace (st_parameter_file
*** 120,126 ****
    else
      reverse_memcpy (&m, p, sizeof (gfc_offset));
  
!   new = file_position (u->s) - m - 2*length;
    if (sseek (u->s, new) == FAILURE)
      goto io_error;
  
--- 120,128 ----
    else
      reverse_memcpy (&m, p, sizeof (gfc_offset));
  
!   if ((new = file_position (u->s) - m - 2*length) < 0)
!     new = 0;
! 
    if (sseek (u->s, new) == FAILURE)
      goto io_error;
  
*************** st_backspace (st_parameter_filepos *fpp)
*** 179,184 ****
--- 181,187 ----
  
        u->endfile = NO_ENDFILE;
        u->current_record = 0;
+       u->bytes_left = 0;
      }
  
   done:
Index: io/transfer.c
===================================================================
*** io/transfer.c	(revision 109173)
--- io/transfer.c	(working copy)
*************** next_record_r (st_parameter_dt *dtp)
*** 1645,1652 ****
    switch (current_mode (dtp))
      {
      case UNFORMATTED_SEQUENTIAL:
-       dtp->u.p.current_unit->bytes_left += sizeof (gfc_offset);	/* Skip over tail */
  
        /* Fall through...  */
  
      case FORMATTED_DIRECT:
--- 1645,1654 ----
    switch (current_mode (dtp))
      {
      case UNFORMATTED_SEQUENTIAL:
  
+       /* Skip over tail */
+       dtp->u.p.current_unit->bytes_left += sizeof (gfc_offset);
+       
        /* Fall through...  */
  
      case FORMATTED_DIRECT:
*************** next_record_r (st_parameter_dt *dtp)
*** 1656,1662 ****
  
        if (is_seekable (dtp->u.p.current_unit->s))
  	{
! 	  new = file_position (dtp->u.p.current_unit->s) + dtp->u.p.current_unit->bytes_left;
  
  	  /* Direct access files do not generate END conditions,
  	     only I/O errors.  */
--- 1658,1665 ----
  
        if (is_seekable (dtp->u.p.current_unit->s))
  	{
! 	  new = file_position (dtp->u.p.current_unit->s)
! 		+ dtp->u.p.current_unit->bytes_left;
  
  	  /* Direct access files do not generate END conditions,
  	     only I/O errors.  */

! { dg-do run }
! PR25598 Error on repeated backspaces.
! Derived from example given in PR by Dale Ranta
! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
       integer data
       data=-1
       open(unit=11,status='scratch',form='unformatted')
       write(11)data
       read(11,end=        1000 )data
       call abort()
 1000  continue
       backspace 11
       backspace 11
       backspace 11
       read(11,end=        1001 )data
 1001  continue
       if (data.ne.-1) call abort
       close(11)
       end

! { dg-do run }
! PR25598 Error on repeated backspaces.
! Derived from example given in PR by Dale Ranta
! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
       integer data
       data=-1
       open(unit=11,status='scratch',form='unformatted')
       write(11)data
       read(11,end=        1000 )data
       call abort()
 1000  continue
       backspace 11
       backspace 11
       read(11,end=        1001 )data
 1001  continue
       if (data.ne.-1) call abort
       close(11)
       end