procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/33985 (access="stream",form="unformatted" doesn't buffer)

Browse source 
2007-12-02  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
	    Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/33985
	* io/transfer.c (read_block, read_block_direct, write_block, write_buf):
	Don't seek if file position is already there for STREAM I/O.
	(finalize_transfer): For STREAM I/O don't flush unless the file position
	has moved past the start position before the transfer.

Co-Authored-By: Thomas Koenig <tkoenig@gcc.gnu.org>

From-SVN: r130574
This commit is contained in:
Jerry DeLisle 2007-12-02 23:17:16 +00:00
parent 0b93f014a7
commit 2ea7440786
2 changed files with 32 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
libgfortran/ChangeLog
View file

@ -1,3 +1,12 @@
2007-12-02 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/33985
* io/transfer.c (read_block, read_block_direct, write_block, write_buf):
Don't seek if file position is already there for STREAM I/O.
(finalize_transfer): For STREAM I/O don't flush unless the file position
has moved past the start position before the transfer.
2007-12-01 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* intrinsic/stat.c (stat_i4_sub_0, stat_i8_sub_0): Mark parameter

33
libgfortran/io/transfer.c
View file

@ -272,8 +272,10 @@ read_block (st_parameter_dt *dtp, int *length)
if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
if (dtp->u.p.current_unit->strm_pos - 1
!= file_position (dtp->u.p.current_unit->s)
&& sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return NULL;
@ -357,8 +359,10 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
if (dtp->u.p.current_unit->strm_pos - 1
!= file_position (dtp->u.p.current_unit->s)
&& sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return;
@ -533,8 +537,10 @@ write_block (st_parameter_dt *dtp, int length)
if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
if (dtp->u.p.current_unit->strm_pos - 1
!= file_position (dtp->u.p.current_unit->s)
&& sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return NULL;
@ -595,8 +601,10 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
if (dtp->u.p.current_unit->strm_pos - 1
!= file_position (dtp->u.p.current_unit->s)
&& sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return FAILURE;
@ -2640,8 +2648,13 @@ finalize_transfer (st_parameter_dt *dtp)
{
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);
if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED
&& file_position (dtp->u.p.current_unit->s) >= dtp->rec)
{
flush (dtp->u.p.current_unit->s);
sfree (dtp->u.p.current_unit->s);
}
return;
}