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

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:  forgot to patch queue.
Jerry DeLisle wrote:
> 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;