diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/io.c | 5 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 7 | ||||
| -rw-r--r-- | libgfortran/io/transfer.c | 92 |
4 files changed, 85 insertions, 26 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f17cbac..5cdbb23 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 85b712f..97f304b 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -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); diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index bb860d4..7aba026 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -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 diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index c4fae32..4ddfd9f 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -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; } |