[patch,libgfortran] Fix PR29277 Formated stream output
Jerry DeLisle
jvdelisle@verizon.net
Sun Oct 15 21:24:00 GMT 2006
PING
I would suggest this patch go in as is. This will work on every system I can
find except mingw. Cygwin does its own CR-LF magic. This should actually
execute fine on mingw, but will not embed a CR accept at the ends of records.
The patch for that I am still working on and it is completely independent of the
patch here.
TIA for any additional testing others can do for this. In fact is it Paul or FX
that does the regular mingw build? That is the one build I need to test this
with most.
Regards,
Jerry
Jerry DeLisle wrote:
> :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
More information about the Fortran
mailing list