This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch,libgfortran] Fix PR29277 Formated stream output
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: Fortran List <fortran at gcc dot gnu dot org>
- Cc: gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 12 Oct 2006 18:32:58 -0700
- Subject: [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