Commit 807fb853 by Jerry DeLisle

re PR fortran/29563 (Internal read loses data.)

2006-10-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/29563
	* io/io.h (st_parameter_dt): Add new flag at_eof.
	* io/list_read.c (next_char): Set flag when EOF and return '\n' to
	signal EOR.  Check flag on next call and jump out.
	* io/unit.c (get_internal_unit): Initialize new flag.

From-SVN: r118059
parent 7445de0a
2006-10-25 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/29563
* io/io.h (st_parameter_dt): Add new flag at_eof.
* io/list_read.c (next_char): Set flag when EOF and return '\n' to
signal EOR. Check flag on next call and jump out.
* io/unit.c (get_internal_unit): Initialize new flag.
2006-10-22 Francois-Xavier Coudert <coudert@clipper.ens.fr> 2006-10-22 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/26025 PR fortran/26025
......
...@@ -415,7 +415,10 @@ typedef struct st_parameter_dt ...@@ -415,7 +415,10 @@ typedef struct st_parameter_dt
/* An internal unit specific flag used to identify that the associated /* An internal unit specific flag used to identify that the associated
unit is internal. */ unit is internal. */
unsigned unit_is_internal : 1; unsigned unit_is_internal : 1;
/* 17 unused bits. */ /* An internal unit specific flag to signify an EOF condition for list
directed read. */
unsigned at_eof : 1;
/* 16 unused bits. */
char last_char; char last_char;
char nml_delim; char nml_delim;
......
...@@ -163,26 +163,35 @@ next_char (st_parameter_dt *dtp) ...@@ -163,26 +163,35 @@ next_char (st_parameter_dt *dtp)
dtp->u.p.line_buffer_enabled = 0; dtp->u.p.line_buffer_enabled = 0;
} }
/* Handle the end-of-record condition for internal array unit */ /* Handle the end-of-record and end-of-file conditions for
if (is_array_io(dtp) && dtp->u.p.current_unit->bytes_left == 0) internal array unit. */
if (is_array_io(dtp))
{ {
c = '\n'; if (dtp->u.p.at_eof)
record = next_array_record (dtp, dtp->u.p.current_unit->ls);
/* Check for "end-of-file" condition */
if (record == 0)
longjmp (*dtp->u.p.eof_jump, 1); longjmp (*dtp->u.p.eof_jump, 1);
record *= dtp->u.p.current_unit->recl; /* Check for "end-of-record" condition. */
if (dtp->u.p.current_unit->bytes_left == 0)
if (sseek (dtp->u.p.current_unit->s, record) == FAILURE) {
longjmp (*dtp->u.p.eof_jump, 1); record = next_array_record (dtp, dtp->u.p.current_unit->ls);
dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; /* Check for "end-of-file" condition. */
goto done; if (record == 0)
{
dtp->u.p.at_eof = 1;
c = '\n';
goto done;
}
record *= dtp->u.p.current_unit->recl;
if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
longjmp (*dtp->u.p.eof_jump, 1);
dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
}
} }
/* Get the next character and handle end-of-record conditions */ /* Get the next character and handle end-of-record conditions. */
length = 1; length = 1;
...@@ -196,7 +205,7 @@ next_char (st_parameter_dt *dtp) ...@@ -196,7 +205,7 @@ next_char (st_parameter_dt *dtp)
if (is_array_io(dtp)) if (is_array_io(dtp))
{ {
/* End of record is handled in the next pass through, above. The /* End of record is handled in the next pass through, above. The
check for NULL here is cautionary. */ check for NULL here is cautionary. */
if (p == NULL) if (p == NULL)
{ {
generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL);
......
...@@ -430,6 +430,7 @@ get_internal_unit (st_parameter_dt *dtp) ...@@ -430,6 +430,7 @@ get_internal_unit (st_parameter_dt *dtp)
dtp->u.p.skips = 0; dtp->u.p.skips = 0;
dtp->u.p.pending_spaces = 0; dtp->u.p.pending_spaces = 0;
dtp->u.p.max_pos = 0; dtp->u.p.max_pos = 0;
dtp->u.p.at_eof = 0;
/* This flag tells us the unit is assigned to internal I/O. */ /* This flag tells us the unit is assigned to internal I/O. */
......
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