diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 24 | ||||
| -rw-r--r-- | libgfortran/io/transfer.c | 106 | ||||
| -rw-r--r-- | libgfortran/io/write_float.def | 3 | ||||
| -rw-r--r-- | libgfortran/runtime/main.c | 3 |
4 files changed, 109 insertions, 27 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 36c0098cab2..765bbd78b3e 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,27 @@ +2008-12-06 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libfortran/38291 + * io/transfer.c (data_transfer_init): Add fbuf_flush inadvertently + ommitted. Add check for invalid use of REC= with ACCESS="stream". Fix + comment. + +2008-12-06 Adam Nemet <anemet@caviumnetworks.com> + + * runtime/main.c (store_exe_path): Don't crash if argv0 is NULL. + +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 + * write_float.def (WRITE_FLOAT): Zero the float value for special case + only if scale_factor = 0. + 2008-11-23 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/38234 diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index c4fae32bead..318d2215ee2 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1967,7 +1967,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) return; } - /* Check the record or position number. */ + /* Check the record number. */ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT && (cf & IOPARM_DT_HAS_REC) == 0) @@ -1986,6 +1986,15 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) return; } + if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM + && (cf & IOPARM_DT_HAS_REC) != 0) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Record number not allowed for stream access " + "data transfer"); + return; + } + /* Process the ADVANCE option. */ dtp->u.p.advance_status @@ -2116,6 +2125,65 @@ 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) + { + fbuf_flush (dtp->u.p.current_unit, 1); + 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 +2207,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 +2224,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; } diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index 8bb4123084f..d8799f2ae03 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -760,7 +760,8 @@ sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ return;\ }\ tmp = sign_bit ? -tmp : tmp;\ - if (f->u.real.d == 0 && f->format == FMT_F)\ + if (f->u.real.d == 0 && f->format == FMT_F\ + && dtp->u.p.scale_factor == 0)\ {\ if (tmp < 0.5)\ tmp = 0.0;\ diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c index 71b481a7deb..947b3985238 100644 --- a/libgfortran/runtime/main.c +++ b/libgfortran/runtime/main.c @@ -111,7 +111,8 @@ store_exe_path (const char * argv0) char buf[PATH_MAX], *cwd, *path; - if (argv0[0] == '/') + /* On the simulator argv is not set. */ + if (argv0 == NULL || argv0[0] == '/') { exe_path = argv0; please_free_exe_path_when_done = 0; |