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

re PR libfortran/25307 (internal read with end=label aborts)

Browse source 
2005-12-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/25307
	* io/list_read.c (next_char): Handle end-of-file conditions for
	internal units and add support for internal character array units.

From-SVN: r108938
This commit is contained in:
Jerry DeLisle 2005-12-22 02:32:29 +00:00
parent 4e2d94a917
commit 8ad4c89538
2 changed files with 58 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
libgfortran/ChangeLog
View file

@ -1,3 +1,9 @@
2005-12-21 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/25307
* io/list_read.c (next_char): Handle end-of-file conditions for
internal units and add support for internal character array units.
2005-12-18 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/25463

65
libgfortran/io/list_read.c
View file

@ -121,6 +121,7 @@ static char
next_char (st_parameter_dt *dtp)
{
int length;
gfc_offset record;
char c, *p;
if (dtp->u.p.last_char != '\0')
@ -133,26 +134,64 @@ next_char (st_parameter_dt *dtp)
length = 1;
p = salloc_r (dtp->u.p.current_unit->s, &length);
if (p == NULL)
/* Handle the end-of-record condition for internal array unit */
if (is_array_io(dtp) && dtp->u.p.current_unit->bytes_left == 0)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return '\0';
c = '\n';
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);
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;
goto done;
}
if (length == 0)
/* Get the next character and handle end-of-record conditions */
p = salloc_r (dtp->u.p.current_unit->s, &length);
if (is_internal_unit(dtp))
{
/* For internal files return a newline instead of signalling EOF. */
/* ??? This isn't quite right, but we don't handle internal files
with multiple records. */
if (is_internal_unit (dtp))
c = '\n';
if (is_array_io(dtp))
{
/* End of record is handled in the next pass through, above. The
check for NULL here is cautionary. */
if (p == NULL)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return '\0';
}
dtp->u.p.current_unit->bytes_left--;
c = *p;
}
else
longjmp (*dtp->u.p.eof_jump, 1);
{
if (p == NULL)
longjmp (*dtp->u.p.eof_jump, 1);
if (length == 0)
c = '\n';
else
c = *p;
}
}
else
c = *p;
{
if (p == NULL)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return '\0';
}
if (length == 0)
longjmp (*dtp->u.p.eof_jump, 1);
c = *p;
}
done:
dtp->u.p.at_eol = (c == '\n' || c == '\r');
return c;