This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch,libgfortran] Fix PR29277 Formated stream output


:ADDPATCH fortran:

This patch utilizes the existing routines for sequential formatted reads and writes modified to update the STREAM position pointer. The effect of this is to get the '\n' or '\r\n' in the right spots after the formatted I/O.

I have not tested this with a system that actually uses CR-LF, so I need someone to do that if possible.

I have included a minor fix in eat_separator. The unget_char is only one character deep so there is no point to two ungets in a row. The previous code was actually tossing out a potential non separator character if it followed a '\r' by itself. (It should never see that, but nevertheless I fixed it.)

Revised test case streamio_4.f90 and new test case streamio_11.f90 provided by Tobias Burnus attached. Much appreciation to Tobias for identifying these issues and giving a test case.

Regression tested on the latest svn trunk on i686-linux.

OK to commit after passing the CR-LF tests?

Regards,

Jerry

2006-10-06 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libgfortran/29277
	* io/list_read.c (next_char): Update strm_pos.
	(eat_separator): Delete extra call to unget_char.
	* io/transfer.c (read_block): Use read_sf for formatted stream I/O.
	(next_record_r): Update strm_pos for formatted stream I/O and handle
	end-of-record correctly.
	(next_record_w): Ditto.
	(next_record): Enable next record (r/w) functions and update strm_pos.
	(finalize_transfer): Call next_record to finish the record.
Index: list_read.c
===================================================================
*** list_read.c	(revision 117682)
--- list_read.c	(working copy)
*************** next_char (st_parameter_dt *dtp)
*** 187,192 ****
--- 187,195 ----
    length = 1;
  
    p = salloc_r (dtp->u.p.current_unit->s, &length);
+   
+   if (is_stream_io (dtp))
+     dtp->u.p.current_unit->strm_pos++;
  
    if (is_internal_unit(dtp))
      {
*************** eat_separator (st_parameter_dt *dtp)
*** 294,303 ****
        if (n == '\n')
  	dtp->u.p.at_eol = 1;
        else
!         {
! 	  unget_char (dtp, n);
! 	  unget_char (dtp, c);
!         } 
        break;
  
      case '\n':
--- 297,303 ----
        if (n == '\n')
  	dtp->u.p.at_eol = 1;
        else
! 	unget_char (dtp, n);
        break;
  
      case '\n':
Index: transfer.c
===================================================================
*** transfer.c	(revision 117682)
--- transfer.c	(working copy)
*************** read_block (st_parameter_dt *dtp, int *l
*** 324,329 ****
--- 324,336 ----
  	  return NULL;
  	}
  
+       if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
+ 	{
+ 	  source = read_sf (dtp, length, 0);
+ 	  dtp->u.p.current_unit->strm_pos +=
+ 	    (gfc_offset) (*length + dtp->u.p.sf_seen_eor);
+ 	  return source;
+ 	}
        nread = *length;
        source = salloc_r (dtp->u.p.current_unit->s, &nread);
  
*************** next_record_r (st_parameter_dt *dtp)
*** 1921,1928 ****
  
    switch (current_mode (dtp))
      {
!     /* No records in STREAM I/O.  */
!     case FORMATTED_STREAM:
      case UNFORMATTED_STREAM:
        return;
      
--- 1928,1934 ----
  
    switch (current_mode (dtp))
      {
!     /* No records in unformatted STREAM I/O.  */
      case UNFORMATTED_STREAM:
        return;
      
*************** next_record_r (st_parameter_dt *dtp)
*** 1970,1975 ****
--- 1976,1982 ----
  	}
        break;
  
+     case FORMATTED_STREAM:
      case FORMATTED_SEQUENTIAL:
        length = 1;
        /* sf_read has already terminated input because of an '\n'  */
*************** next_record_r (st_parameter_dt *dtp)
*** 2019,2024 ****
--- 2026,2034 ----
  	      dtp->u.p.current_unit->endfile = AT_ENDFILE;
  	      break;
  	    }
+ 
+ 	  if (is_stream_io (dtp))
+ 	    dtp->u.p.current_unit->strm_pos++;
  	}
        while (*p != '\n');
  
*************** next_record_w (st_parameter_dt *dtp, int
*** 2116,2123 ****
  
    switch (current_mode (dtp))
      {
!     /* No records in STREAM I/O.  */
!     case FORMATTED_STREAM:
      case UNFORMATTED_STREAM:
        return;
  
--- 2126,2132 ----
  
    switch (current_mode (dtp))
      {
!     /* No records in unformatted STREAM I/O.  */
      case UNFORMATTED_STREAM:
        return;
  
*************** next_record_w (st_parameter_dt *dtp, int
*** 2168,2173 ****
--- 2177,2183 ----
  
        break;
  
+     case FORMATTED_STREAM:
      case FORMATTED_SEQUENTIAL:
  
        if (is_internal_unit (dtp))
*************** next_record_w (st_parameter_dt *dtp, int
*** 2241,2248 ****
  	}
        else
  	{
- 	  if (dtp->u.p.current_unit->bytes_left == 0)
- 	    break;
  
  	  /* If this is the last call to next_record move to the farthest
  	  position reached in preparation for completing the record.
--- 2251,2256 ----
*************** next_record_w (st_parameter_dt *dtp, int
*** 2266,2271 ****
--- 2274,2282 ----
  #endif
  	  if (swrite (dtp->u.p.current_unit->s, &crlf[2-len], &len) != 0)
  	    goto io_error;
+ 	  
+ 	  if (is_stream_io (dtp))
+ 	    dtp->u.p.current_unit->strm_pos += len;
  	}
  
        break;
*************** next_record_w (st_parameter_dt *dtp, int
*** 2284,2292 ****
  void
  next_record (st_parameter_dt *dtp, int done)
  {
-   if (is_stream_io (dtp))
-     return;
- 
    gfc_offset fp; /* File position.  */
  
    dtp->u.p.current_unit->read_bad = 0;
--- 2295,2300 ----
*************** next_record (st_parameter_dt *dtp, int d
*** 2296,2313 ****
    else
      next_record_w (dtp, done);
  
!   /* keep position up to date for INQUIRE */
!   dtp->u.p.current_unit->flags.position = POSITION_ASIS;
!   dtp->u.p.current_unit->current_record = 0;
!   if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
!    {
!     fp = file_position (dtp->u.p.current_unit->s);
!     /* Calculate next record, rounding up partial records.  */
!     dtp->u.p.current_unit->last_record = (fp + dtp->u.p.current_unit->recl - 1)
! 				/ dtp->u.p.current_unit->recl;
!    }
!   else
!     dtp->u.p.current_unit->last_record++;
  
    if (!done)
      pre_position (dtp);
--- 2304,2325 ----
    else
      next_record_w (dtp, done);
  
!   if (!is_stream_io (dtp))
!     {
!       /* keep position up to date for INQUIRE */
!       dtp->u.p.current_unit->flags.position = POSITION_ASIS;
!       dtp->u.p.current_unit->current_record = 0;
!       if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
! 	{
! 	  fp = file_position (dtp->u.p.current_unit->s);
! 	  /* Calculate next record, rounding up partial records.  */
! 	  dtp->u.p.current_unit->last_record =
! 	    (fp + dtp->u.p.current_unit->recl - 1) /
! 	      dtp->u.p.current_unit->recl;
! 	}
!       else
! 	dtp->u.p.current_unit->last_record++;
!     }
  
    if (!done)
      pre_position (dtp);
*************** finalize_transfer (st_parameter_dt *dtp)
*** 2373,2379 ****
        next_record (dtp, 1);
      }
    else
!     flush (dtp->u.p.current_unit->s);
  
    sfree (dtp->u.p.current_unit->s);
  }
--- 2385,2395 ----
        next_record (dtp, 1);
      }
    else
!     {
!       if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
! 	next_record (dtp, 1);
!       flush (dtp->u.p.current_unit->s);
!     }
  
    sfree (dtp->u.p.current_unit->s);
  }
! { dg-do run }
! PR25828 Stream IO test 4, Tests string read and writes, single byte.
! Verifies buffering is working correctly and position="append"
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
program streamtest
  implicit none
  character(1)   :: lf = char(10)
  character(1)   :: tchar
  integer        :: i,j,k
  integer, parameter :: lines = 5231
   
  open(10, file="teststream", access="stream", form="formatted")
  
  do i=1,lines
    do j=0,9
      write(10,"(i5)") j
    end do
  end do
  
  close(10)
  
  open(10, file="teststream", access="stream",&
  &form="formatted", position="append")
  do i=1,lines
    do j=0,9
      write(10,"(i5)") j
    end do
  end do
  rewind(10)
  do i=1,lines
    do j=0,9
      read(10,"(i5)") k
      if (k.ne.j) call abort()
    end do
  end do

  close(10,status="delete")
end program streamtest
! { dg-do run }
! PR29277 Stream IO test 11, tests formatted form.
! Contributed by Tobias Burnas.
program stream_test
    implicit none
    character(len=*), parameter :: rec1 = 'record1'
    character(len=*), parameter :: rec2 = 'record2'
    character(len=50) :: str1,str2
    integer           :: len, i
    real              :: r

    open(10,form='formatted',access='stream',&
         status='scratch',position='rewind')
    write(10,'(a)') rec1//new_line('a')//rec2
    rewind(10)
    read(10,*) str1
    read(10,*) str2
    if(str1 /= rec1 .or. str2 /= rec2) call abort()
    rewind(10)
    read(10,'(a)') str1
    read(10,'(a)') str2
    if(str1 /= rec1 .or. str2 /= rec2) call abort()
    close(10)

    open(10,form='formatted',access='stream',&
         status='scratch',position='rewind')
    write(10,*) '123 '//trim(rec1)//'  1e-12'
    write(10,*) '12345.6789'
    rewind(10)
    read(10,*) i,str1
    read(10,*) r
    if(i /= 123 .or. str1 /= rec1 .or. r /= 12345.6789) &
      call abort()
    close(10)

    open(unit=10,form='unformatted',access='stream', &
         status='scratch',position='rewind')
    write(10) rec1//new_line('a')//rec2
    len = len_trim(rec1//new_line('a')//rec2)
    rewind(10)
    read(10) str1(1:len)
    if(str1 /= rec1//new_line('a')//rec2) call abort()
end program stream_test

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]