mirrors/gcc
1
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-25 11:54:01 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

re PR fortran/38291 (Rejects I/O with POS= if FMT=*)

Browse Source 
2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/38291
	* io.c (match_dt_element): Use dt->pos in matcher.
	(gfc_free_dt): Free dt->pos after use.
	(gfc_resolve_dt): Use dt->pos in resolution of stream position tag.

2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/38291
	* io/transfer.c (data_transfer_init): Add checks for POS= valid range.
	Add check for unit opened with ACCESS="stream". Flush and seek if
	current stream position does not match. Check ENDFILE on read.

From-SVN: r142515
This commit is contained in:
Jerry DeLisle 2008-12-06 04:13:34 +00:00
parent a2a6f3cf6b
commit 4c934d41d2
4 changed files with 85 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2008-12-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/38291
* io.c (match_dt_element): Use dt->pos in matcher.
(gfc_free_dt): Free dt->pos after use.
(gfc_resolve_dt): Use dt->pos in resolution of stream position tag.
2008-12-05 Sebastian Pop <sebastian.pop@amd.com>
PR bootstrap/38262

5
gcc/fortran/io.c
View File

@ -2412,7 +2412,7 @@ match_dt_element (io_kind k, gfc_dt *dt)
m = match_etag (&tag_rec, &dt->rec);
if (m != MATCH_NO)
return m;
m = match_etag (&tag_spos, &dt->rec);
m = match_etag (&tag_spos, &dt->pos);
if (m != MATCH_NO)
return m;
m = match_out_tag (&tag_iomsg, &dt->iomsg);
@ -2478,6 +2478,7 @@ gfc_free_dt (gfc_dt *dt)
gfc_free_expr (dt->blank);
gfc_free_expr (dt->decimal);
gfc_free_expr (dt->extra_comma);
gfc_free_expr (dt->pos);
gfc_free (dt);
}
@ -2491,7 +2492,7 @@ gfc_resolve_dt (gfc_dt *dt)
RESOLVE_TAG (&tag_format, dt->format_expr);
RESOLVE_TAG (&tag_rec, dt->rec);
RESOLVE_TAG (&tag_spos, dt->rec);
RESOLVE_TAG (&tag_spos, dt->pos);
RESOLVE_TAG (&tag_advance, dt->advance);
RESOLVE_TAG (&tag_id, dt->id);
RESOLVE_TAG (&tag_iomsg, dt->iomsg);

7
libgfortran/ChangeLog
View File

@ -1,3 +1,10 @@
2008-12-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/38291
* io/transfer.c (data_transfer_init): Add checks for POS= valid range.
Add check for unit opened with ACCESS="stream". Flush and seek if
current stream position does not match. Check ENDFILE on read.
2008-12-04 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/38285

92
libgfortran/io/transfer.c
View File

@ -2116,6 +2116,62 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad;
/* Check the POS= specifier: that it is in range and that it is used with a
unit that has been connected for STREAM access. F2003 9.5.1.10. */
if (((cf & IOPARM_DT_HAS_POS) != 0))
{
if (is_stream_io (dtp))
{
if (dtp->pos <= 0)
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier must be positive");
return;
}
if (dtp->rec >= dtp->u.p.current_unit->maxrec)
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier too large");
return;
}
dtp->rec = dtp->pos;
if (dtp->u.p.mode == READING)
{
/* Required for compatibility between 4.3 and 4.4 runtime. Check
to see if we might be reading what we wrote before */
if (dtp->u.p.current_unit->mode == WRITING)
flush(dtp->u.p.current_unit->s);
if (dtp->pos < file_length (dtp->u.p.current_unit->s))
dtp->u.p.current_unit->endfile = NO_ENDFILE;
}
if (dtp->pos != dtp->u.p.current_unit->strm_pos)
{
fbuf_flush (dtp->u.p.current_unit, 1);
flush (dtp->u.p.current_unit->s);
if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
dtp->u.p.current_unit->strm_pos = dtp->pos;
}
}
else
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier not allowed, "
"Try OPEN with ACCESS='stream'");
return;
}
}
/* Sanity checks on the record number. */
if ((cf & IOPARM_DT_HAS_REC) != 0)
@ -2139,10 +2195,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
if (dtp->u.p.mode == READING
&& dtp->u.p.current_unit->mode == WRITING
&& !is_internal_unit (dtp))
{
fbuf_flush (dtp->u.p.current_unit, 1);
{
fbuf_flush (dtp->u.p.current_unit, 1);
flush(dtp->u.p.current_unit->s);
}
}
/* Check whether the record exists to be read. Only
a partial record needs to exist. */
@ -2156,29 +2212,17 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
}
/* Position the file. */
if (!is_stream_io (dtp))
if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
* dtp->u.p.current_unit->recl) == FAILURE)
{
if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
* dtp->u.p.current_unit->recl) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
else
{
if (dtp->u.p.current_unit->strm_pos != dtp->rec)
{
fbuf_flush (dtp->u.p.current_unit, 1);
flush (dtp->u.p.current_unit->s);
if (sseek (dtp->u.p.current_unit->s, dtp->rec - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
dtp->u.p.current_unit->strm_pos = dtp->rec;
}
}
/* This is required to maintain compatibility between
4.3 and 4.4 runtime. */
if (is_stream_io (dtp))
dtp->u.p.current_unit->strm_pos = dtp->rec;
}