[patch, libgfortran] PR25139 and PR25510

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

This patch includes the "simple" patch for 25139 and also adds two new error 
types which are then used in list_read.c and transfer.c.  A test case for 25139 
is provided.  I do not have a test case for the new error types. These errors 
would likely only occur during testing of new code if we screw up.

I will rename backspace.f in testsuite to backspace_1.f at the proper time.

NIST tested, regression tested.  OK for 4.2 and then 4.1 a bit later?

Regards,

Jerry

2005-12-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/25139
	* io/unix.c (fd_truncate): Set set s->active to zero.
	PR libgfortran/25510
	* libgfortran.h: Add ERROR_INTERNAL and ERROR_INTERNAL_UNIT.
	* runtime/error.c (translate_error): Add messages for new errors.
	* io/list_read.c (next_char): Use new errors.
	* io/transfer.c (next_record_r) (next_record_w): Use new errors.

Index: runtime/error.c
===================================================================
*** runtime/error.c	(revision 109007)
--- runtime/error.c	(working copy)
*************** translate_error (int code)
*** 423,428 ****
--- 423,436 ----
        p = "Numeric overflow on read";
        break;
  
+     case ERROR_INTERNAL:
+       p = "Internal error in run-time library";
+       break;
+ 
+     case ERROR_INTERNAL_UNIT:
+       p = "Internal unit I/O error";
+       break;
+ 
      default:
        p = "Unknown error code";
        break;
Index: libgfortran.h
===================================================================
*** libgfortran.h	(revision 109007)
--- libgfortran.h	(working copy)
*************** typedef enum
*** 407,412 ****
--- 407,414 ----
    ERROR_BAD_US,
    ERROR_READ_VALUE,
    ERROR_READ_OVERFLOW,
+   ERROR_INTERNAL,
+   ERROR_INTERNAL_UNIT,
    ERROR_LAST			/* Not a real error, the last error # + 1.  */
  }
  error_codes;
Index: io/list_read.c
===================================================================
*** io/list_read.c	(revision 109007)
--- io/list_read.c	(working copy)
*************** next_char (st_parameter_dt *dtp)
*** 164,170 ****
  	     check for NULL here is cautionary. */
  	  if (p == NULL)
  	    {
! 	      generate_error (&dtp->common, ERROR_OS, NULL);
  	      return '\0';
  	    }
  
--- 164,170 ----
  	     check for NULL here is cautionary. */
  	  if (p == NULL)
  	    {
! 	      generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL);
  	      return '\0';
  	    }
  
Index: io/unix.c
===================================================================
*** io/unix.c	(revision 109007)
--- io/unix.c	(working copy)
*************** fd_truncate (unix_stream * s)
*** 601,607 ****
      }
  
    s->physical_offset = s->file_length = s->logical_offset;
! 
    return SUCCESS;
  }
  
--- 601,607 ----
      }
  
    s->physical_offset = s->file_length = s->logical_offset;
!   s->active = 0;
    return SUCCESS;
  }
  
Index: io/transfer.c
===================================================================
*** io/transfer.c	(revision 109007)
--- io/transfer.c	(working copy)
*************** next_record_r (st_parameter_dt *dtp)
*** 1702,1708 ****
  	      record = record * dtp->u.p.current_unit->recl;
  	      if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
  		{
! 		  generate_error (&dtp->common, ERROR_OS, NULL);
  		  break;
  		}
  	      dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
--- 1702,1708 ----
  	      record = record * dtp->u.p.current_unit->recl;
  	      if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
  		{
! 		  generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL);
  		  break;
  		}
  	      dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
*************** next_record_w (st_parameter_dt *dtp, int
*** 1863,1869 ****
  	      record = record * dtp->u.p.current_unit->recl;
  
  	      if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
! 		goto io_error;
  
  	      dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
  	    }
--- 1863,1872 ----
  	      record = record * dtp->u.p.current_unit->recl;
  
  	      if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
! 		{
! 		  generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL);
! 		  return;
! 		}
  
  	      dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
  	    }

! { dg-do run }
! PR25139 Repeated backspaces and reads.
! Derived from example given in PR by Dale Ranta and FX Coudert
! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
      integer dat(5)
      dat = (/ 0, 0, 0, 0, 1 /)
      write(11) dat,dat,dat,dat
      rewind 11
      write(11) dat
      read(11,end=1008) dat
      call abort()
 1008 continue
      backspace 11
      write(11) dat
      read(11,end=1011) dat
      call abort()
 1011 continue
      backspace 11
      backspace 11
      end