[patch, libgfortran] PR25307 internal read with end=label aborts FIXED

[Jerry DeLisle <jvdelisle at verizon dot net>]

The attached patch fixes this PR.  In list_read.c, next_char was not handling 
the cases of internal character unit and internal character array unit.  I have 
made judicious use of lessons learned on next_record_w and handling of arrayio 
routines.  The results match behavior of ifort.

NIST Tested, regression tested, test case attached.  OK for main and 4.1?

Cheers,

Jerry

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

	PR libgfortran/25307
	* io/list_read.c (next_char): Handle end-of-file conditions for
	internal units and add support for internal character array units.

Index: io/list_read.c
===================================================================
*** io/list_read.c	(revision 108670)
--- io/list_read.c	(working copy)
*************** static char
*** 121,126 ****
--- 121,127 ----
  next_char (st_parameter_dt *dtp)
  {
    int length;
+   gfc_offset record;
    char c, *p;
  
    if (dtp->u.p.last_char != '\0')
*************** next_char (st_parameter_dt *dtp)
*** 133,158 ****
  
    length = 1;
  
!   p = salloc_r (dtp->u.p.current_unit->s, &length);
!   if (p == NULL)
      {
!       generate_error (&dtp->common, ERROR_OS, NULL);
!       return '\0';
      }
  
!   if (length == 0)
      {
!       /* For internal files return a newline instead of signalling EOF.  */
!       /* ??? This isn't quite right, but we don't handle internal files
! 	 with multiple records.  */
!       if (is_internal_unit (dtp))
! 	c = '\n';
        else
! 	longjmp (*dtp->u.p.eof_jump, 1);
      }
    else
!     c = *p;
! 
  done:
    dtp->u.p.at_eol = (c == '\n' || c == '\r');
    return c;
--- 134,197 ----
  
    length = 1;
  
!   /* Handle the end-of-record condition for internal array unit */
!   if (is_array_io(dtp) && dtp->u.p.current_unit->bytes_left == 0)
      {
!       c = '\n';
!       record = next_array_record (dtp, dtp->u.p.current_unit->ls);
! 
!       /* Check for "end-of-file condition */      
!       if (record == 0)
!         longjmp (*dtp->u.p.eof_jump, 1);
! 
!       record *= dtp->u.p.current_unit->recl;
!       
!       if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
! 	longjmp (*dtp->u.p.eof_jump, 1);
! 
!       dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
!       goto done;
      }
  
!   /* Get the next character and handle end-of-record conditions */
!   p = salloc_r (dtp->u.p.current_unit->s, &length);
! 
!   if (is_internal_unit(dtp))
      {
!       if (is_array_io(dtp))
! 	{
! 	  /* End of record is handled in the next pass through, above.  The
! 	     check for NULL here is cautionary. */
! 	  if (p == NULL)
! 	    {
! 	      generate_error (&dtp->common, ERROR_OS, NULL);
! 	      return '\0';
! 	    }
! 
! 	  dtp->u.p.current_unit->bytes_left--;
! 	  c = *p;
! 	}
        else
! 	{
! 	  if (p == NULL)
! 	    longjmp (*dtp->u.p.eof_jump, 1);
! 	  if (length == 0)
! 	    c = '\n';
! 	  else
! 	    c = *p;
! 	}
      }
    else
!     {
!       if (p == NULL)
! 	{
! 	  generate_error (&dtp->common, ERROR_OS, NULL);
! 	  return '\0';
! 	}
!       if (length == 0)
! 	longjmp (*dtp->u.p.eof_jump, 1);
!       c = *p;
!     }
  done:
    dtp->u.p.at_eol = (c == '\n' || c == '\r');
    return c;

Attachment: list_read_5.f90
Description: application/extension-f90