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]

Re: [patch,libgfortran] Fix PR29277 Formated stream output


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


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