Skip to content

R
riscv-gcc-1
Commit 97cd182d by Jerry DeLisle
Options

re PR libfortran/25545 (internal file and dollar edit descriptor) 

2006-11-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/25545
	* io/transfer.c (write_block): Cleanup code paths between
	stream and non-stream I/O.
	(write_buf):  Cleanup.
	(read_block): Cleanup.
	(finalize_transfer): Call next_record for '$' edit descriptor handling
	of internal unit. Cleanup code for readability.

From-SVN: r118506
parent 449c4801
Showing with 69 additions and 82 deletions
libgfortran/ChangeLog
2006-11-04 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/25545
* io/transfer.c (write_block): Cleanup code paths between
stream and non-stream I/O.
(write_buf): Cleanup.
(read_block): Cleanup.
(finalize_transfer): Call next_record for '$' edit descriptor handling
of internal unit. Cleanup code for readability.
2006-11-03 Francois-Xavier Coudert <coudert@clipper.ens.fr> 2006-11-03 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/27895 PR libfortran/27895
......
libgfortran/io/transfer.c
...@@ -263,7 +263,16 @@ read_block (st_parameter_dt *dtp, int *length) ...@@ -263,7 +263,16 @@ read_block (st_parameter_dt *dtp, int *length)
char *source; char *source;
int nread; int nread;
if (!is_stream_io (dtp)) if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
return NULL;
}
}
else
{ {
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length) if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length)
{ {
...@@ -291,46 +300,19 @@ read_block (st_parameter_dt *dtp, int *length) ...@@ -291,46 +300,19 @@ read_block (st_parameter_dt *dtp, int *length)
*length = dtp->u.p.current_unit->bytes_left; *length = dtp->u.p.current_unit->bytes_left;
} }
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
return read_sf (dtp, length, 0); /* Special case. */
dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length;
nread = *length;
source = salloc_r (dtp->u.p.current_unit->s, &nread);
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
dtp->u.p.size_used += (gfc_offset) nread;
if (nread != *length)
{ /* Short read, this shouldn't happen. */
if (dtp->u.p.current_unit->flags.pad == PAD_YES)
*length = nread;
else
{
generate_error (&dtp->common, ERROR_EOR, NULL);
source = NULL;
}
}
}
else
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
return NULL;
} }
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED) if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
(dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
{ {
source = read_sf (dtp, length, 0); source = read_sf (dtp, length, 0);
dtp->u.p.current_unit->strm_pos += dtp->u.p.current_unit->strm_pos +=
(gfc_offset) (*length + dtp->u.p.sf_seen_eor); (gfc_offset) (*length + dtp->u.p.sf_seen_eor);
return source; return source;
} }
dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length;
nread = *length; nread = *length;
source = salloc_r (dtp->u.p.current_unit->s, &nread); source = salloc_r (dtp->u.p.current_unit->s, &nread);
...@@ -343,13 +325,13 @@ read_block (st_parameter_dt *dtp, int *length) ...@@ -343,13 +325,13 @@ read_block (st_parameter_dt *dtp, int *length)
*length = nread; *length = nread;
else else
{ {
generate_error (&dtp->common, ERROR_END, NULL); generate_error (&dtp->common, ERROR_EOR, NULL);
source = NULL; source = NULL;
} }
} }
dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
}
return source; return source;
} }
...@@ -440,7 +422,16 @@ write_block (st_parameter_dt *dtp, int length) ...@@ -440,7 +422,16 @@ write_block (st_parameter_dt *dtp, int length)
{ {
char *dest; char *dest;
if (!is_stream_io (dtp)) if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return NULL;
}
}
else
{ {
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length) if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length)
{ {
...@@ -458,7 +449,7 @@ write_block (st_parameter_dt *dtp, int length) ...@@ -458,7 +449,7 @@ write_block (st_parameter_dt *dtp, int length)
} }
dtp->u.p.current_unit->bytes_left -= (gfc_offset) length; dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
}
dest = salloc_w (dtp->u.p.current_unit->s, &length); dest = salloc_w (dtp->u.p.current_unit->s, &length);
...@@ -473,26 +464,8 @@ write_block (st_parameter_dt *dtp, int length) ...@@ -473,26 +464,8 @@ write_block (st_parameter_dt *dtp, int length)
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
dtp->u.p.size_used += (gfc_offset) length; dtp->u.p.size_used += (gfc_offset) length;
}
else
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return NULL;
}
dest = salloc_w (dtp->u.p.current_unit->s, &length);
if (dest == NULL)
{
generate_error (&dtp->common, ERROR_END, NULL);
return NULL;
}
dtp->u.p.current_unit->strm_pos += (gfc_offset) length; dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
}
return dest; return dest;
} }
...@@ -503,7 +476,16 @@ write_block (st_parameter_dt *dtp, int length) ...@@ -503,7 +476,16 @@ write_block (st_parameter_dt *dtp, int length)
static try static try
write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
{ {
if (!is_stream_io (dtp)) if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return FAILURE;
}
}
else
{ {
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes) if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)
{ {
...@@ -526,15 +508,6 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) ...@@ -526,15 +508,6 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes; dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
} }
else
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return FAILURE;
}
}
if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0) if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
{ {
...@@ -542,12 +515,9 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) ...@@ -542,12 +515,9 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
return FAILURE; return FAILURE;
} }
if (!is_stream_io (dtp))
{
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
dtp->u.p.size_used += (gfc_offset) nbytes; dtp->u.p.size_used += (gfc_offset) nbytes;
}
else
dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes; dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
return SUCCESS; return SUCCESS;
...@@ -2244,6 +2214,7 @@ next_record_w (st_parameter_dt *dtp, int done) ...@@ -2244,6 +2214,7 @@ next_record_w (st_parameter_dt *dtp, int done)
else else
length = (int) dtp->u.p.current_unit->bytes_left; length = (int) dtp->u.p.current_unit->bytes_left;
} }
if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE) if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE)
{ {
generate_error (&dtp->common, ERROR_END, NULL); generate_error (&dtp->common, ERROR_END, NULL);
...@@ -2371,28 +2342,34 @@ finalize_transfer (st_parameter_dt *dtp) ...@@ -2371,28 +2342,34 @@ finalize_transfer (st_parameter_dt *dtp)
} }
if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING) if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
finish_list_read (dtp);
else if (!is_stream_io (dtp))
{ {
dtp->u.p.current_unit->current_record = 0; finish_list_read (dtp);
if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar) sfree (dtp->u.p.current_unit->s);
{
/* Most systems buffer lines, so force the partial record
to be written out. */
if (!is_internal_unit (dtp))
flush (dtp->u.p.current_unit->s);
dtp->u.p.seen_dollar = 0;
return; return;
} }
next_record (dtp, 1);
} if (is_stream_io (dtp))
else
{ {
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED) if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
next_record (dtp, 1); next_record (dtp, 1);
flush (dtp->u.p.current_unit->s); flush (dtp->u.p.current_unit->s);
sfree (dtp->u.p.current_unit->s);
return;
}
dtp->u.p.current_unit->current_record = 0;
if (dtp->u.p.advance_status == ADVANCE_NO)
return;
if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar)
{
dtp->u.p.seen_dollar = 0;
sfree (dtp->u.p.current_unit->s);
return;
} }
next_record (dtp, 1);
sfree (dtp->u.p.current_unit->s); sfree (dtp->u.p.current_unit->s);
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment