OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR libfortran/29627 ([4.1 only] partial unformatted reads shouldn't succeed)

Browse Source 
2006-10-31  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/29627
	* libgfortran.h: Add ERROR_SHORT_RECORD
	* runtime/error.c (translate_error): Add case
	for ERROR_SHORT_RECORD.
	* io/transfer.c (read_block_direct):  Separate codepaths
	for stream and record unformatted I/O.  Remove unneeded
	tests for standard input, padding and formatted I/O.
	If the record is short, read in as much data as possible,
	then raise the error.

2006-10-31  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/29627
	* gfortran.dg/unf_short_record_1.f90:  New test.

From-SVN: r118341
This commit is contained in:
Thomas Koenig 2006-10-31 20:58:26 +00:00 committed by Thomas Koenig
parent 401c8e8059
commit 8a7f7fb6de
6 changed files with 89 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2006-10-31 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/29627
* gfortran.dg/unf_short_record_1.f90: New test.
2006-10-31 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/29067

17
gcc/testsuite/gfortran.dg/unf_short_record_1.f90 Normal file
View File

@ -0,0 +1,17 @@
! { dg-do run }
! PR 29627 - partial reads of unformatted records
program main
character a(3)
character(len=50) msg
open(10, form="unformatted", status="unknown")
write (10) 'a'
write (10) 'c'
a = 'b'
rewind 10
read (10, err=20, iomsg=msg) a
call abort
20 continue
if (msg .ne. "Short record on unformatted read") call abort
if (a(1) .ne. 'a' .or. a(2) .ne. 'b' .or. a(3) .ne. 'b') call abort
close (10, status="delete")
end program main

12
libgfortran/ChangeLog
View File

@ -1,3 +1,15 @@
2006-10-31 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/29627
* libgfortran.h: Add ERROR_SHORT_RECORD
* runtime/error.c (translate_error): Add case
for ERROR_SHORT_RECORD.
* io/transfer.c (read_block_direct): Separate codepaths
for stream and record unformatted I/O. Remove unneeded
tests for standard input, padding and formatted I/O.
If the record is short, read in as much data as possible,
then raise the error.
2006-10-30 Tobias Burnus <burnus@net-b.de>
PR fortran/29452

108
libgfortran/io/transfer.c
View File

@ -359,52 +359,10 @@ read_block (st_parameter_dt *dtp, int *length)
static void
read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
{
int *length;
void *data;
size_t nread;
int short_record;
if (!is_stream_io (dtp))
{
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
{
/* For preconnected units with default record length, set
bytes left to unit record length and proceed, otherwise
error. */
if (dtp->u.p.current_unit->unit_number == options.stdin_unit
&& dtp->u.p.current_unit->recl == DEFAULT_RECL)
dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
else
{
if (dtp->u.p.current_unit->flags.pad == PAD_NO)
{
/* Not enough data left. */
generate_error (&dtp->common, ERROR_EOR, NULL);
return;
}
}
if (dtp->u.p.current_unit->bytes_left == 0)
{
dtp->u.p.current_unit->endfile = AT_ENDFILE;
generate_error (&dtp->common, ERROR_END, NULL);
return;
}
*nbytes = (size_t) 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)
{
length = (int *) nbytes;
data = read_sf (dtp, length, 0); /* Special case. */
memcpy (buf, data, (size_t) *length);
return;
}
dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
}
else
if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
@ -412,29 +370,62 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
generate_error (&dtp->common, ERROR_END, NULL);
return;
}
nread = *nbytes;
if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return;
}
dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
generate_error (&dtp->common, ERROR_END, NULL);
return;
}
nread = *nbytes;
/* Unformatted file with records */
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
{
short_record = 1;
nread = (size_t) dtp->u.p.current_unit->bytes_left;
*nbytes = nread;
if (dtp->u.p.current_unit->bytes_left == 0)
{
dtp->u.p.current_unit->endfile = AT_ENDFILE;
generate_error (&dtp->common, ERROR_END, NULL);
return;
}
}
else
{
short_record = 0;
nread = *nbytes;
}
dtp->u.p.current_unit->bytes_left -= nread;
if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return;
}
if (!is_stream_io (dtp))
{
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
dtp->u.p.size_used += (gfc_offset) nread;
}
else
dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
{
if (!is_stream_io (dtp))
generate_error (&dtp->common, ERROR_EOR, NULL);
else
generate_error (&dtp->common, ERROR_END, NULL);
*nbytes = nread;
generate_error (&dtp->common, ERROR_END, NULL);
return;
}
if (short_record)
{
generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
return;
}
}
@ -595,7 +586,8 @@ unformatted_read (st_parameter_dt *dtp, bt type,
/* By now, all complex variables have been split into their
constituent reals. For types with padding, we only need to
read kind bytes. We don't care about the contents
of the padding. */
of the padding. If we hit a short record, then sz is
adjusted accordingly, making later reads no-ops. */
sz = kind;
for (i=0; i<nelems; i++)

1
libgfortran/libgfortran.h
View File

@ -413,6 +413,7 @@ typedef enum
ERROR_INTERNAL_UNIT,
ERROR_ALLOCATION,
ERROR_DIRECT_EOR,
ERROR_SHORT_RECORD,
ERROR_LAST /* Not a real error, the last error # + 1. */
}
error_codes;

4
libgfortran/runtime/error.c
View File

@ -436,6 +436,10 @@ translate_error (int code)
p = "Write exceeds length of DIRECT access record";
break;
case ERROR_SHORT_RECORD:
p = "Short record on unformatted read";
break;
default:
p = "Unknown error code";
break;