re PR fortran/29277 (Formated stream output: Translate "\n" / achar(10) into "\r\n" on some platforms)

2006-10-17  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.

From-SVN: r117846
This commit is contained in:
Jerry DeLisle 2006-10-18 04:04:07 +00:00
parent 6bc222ff74
commit 09861cbee6
3 changed files with 54 additions and 26 deletions

View File

@ -1,3 +1,15 @@
2006-10-17 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.
2006-10-13 Steven G. Kargl <kargl@gcc.gnu.org>
* m4/spacing.m4: Use scalbn[f,l] if ldexp[f,l] is unavailable.

View File

@ -187,6 +187,9 @@ next_char (st_parameter_dt *dtp)
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))
{
@ -294,10 +297,7 @@ eat_separator (st_parameter_dt *dtp)
if (n == '\n')
dtp->u.p.at_eol = 1;
else
{
unget_char (dtp, n);
unget_char (dtp, c);
}
unget_char (dtp, n);
break;
case '\n':

View File

@ -324,6 +324,13 @@ read_block (st_parameter_dt *dtp, int *length)
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);
@ -1921,8 +1928,7 @@ next_record_r (st_parameter_dt *dtp)
switch (current_mode (dtp))
{
/* No records in STREAM I/O. */
case FORMATTED_STREAM:
/* No records in unformatted STREAM I/O. */
case UNFORMATTED_STREAM:
return;
@ -1970,6 +1976,7 @@ next_record_r (st_parameter_dt *dtp)
}
break;
case FORMATTED_STREAM:
case FORMATTED_SEQUENTIAL:
length = 1;
/* sf_read has already terminated input because of an '\n' */
@ -2019,6 +2026,9 @@ next_record_r (st_parameter_dt *dtp)
dtp->u.p.current_unit->endfile = AT_ENDFILE;
break;
}
if (is_stream_io (dtp))
dtp->u.p.current_unit->strm_pos++;
}
while (*p != '\n');
@ -2116,8 +2126,7 @@ next_record_w (st_parameter_dt *dtp, int done)
switch (current_mode (dtp))
{
/* No records in STREAM I/O. */
case FORMATTED_STREAM:
/* No records in unformatted STREAM I/O. */
case UNFORMATTED_STREAM:
return;
@ -2168,6 +2177,7 @@ next_record_w (st_parameter_dt *dtp, int done)
break;
case FORMATTED_STREAM:
case FORMATTED_SEQUENTIAL:
if (is_internal_unit (dtp))
@ -2241,8 +2251,6 @@ next_record_w (st_parameter_dt *dtp, int done)
}
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.
@ -2266,6 +2274,9 @@ next_record_w (st_parameter_dt *dtp, int done)
#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;
@ -2284,9 +2295,6 @@ next_record_w (st_parameter_dt *dtp, int done)
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;
@ -2296,18 +2304,22 @@ next_record (st_parameter_dt *dtp, int done)
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 (!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);
@ -2373,7 +2385,11 @@ finalize_transfer (st_parameter_dt *dtp)
next_record (dtp, 1);
}
else
flush (dtp->u.p.current_unit->s);
{
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);
}