From: tkoenig Date: Mon, 23 Apr 2007 19:43:54 +0000 (+0000) Subject: 2007-04-23 Thomas Koenig X-Git-Tag: upstream/4.9.2~49040 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=66b0529df85897ff4aa7739ff789f6fef2c6d6ee;p=platform%2Fupstream%2Flinaro-gcc.git 2007-04-23 Thomas Koenig PR fortran/31618 * io/transfer.c (read_block_direct): Instead of calling us_read, set dtp->u.p.current_unit->current_record = 0 so that pre_position will read the record marker. (data_transfer_init): For different error conditions, call generate_error, then return. 2007-04-23 Thomas Koenig PR fortran/31618 * gfortran.dg/backspace_8.f: New test case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@124079 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 22b6f46..1358818 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-04-23 Thomas Koenig + + PR fortran/31618 + * gfortran.dg/backspace_8.f: New test case. + 2007-04-23 Paul Thomas PR fortran/31630 diff --git a/gcc/testsuite/gfortran.dg/backspace_8.f b/gcc/testsuite/gfortran.dg/backspace_8.f new file mode 100644 index 0000000..8c8c96a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/backspace_8.f @@ -0,0 +1,18 @@ +C { dg-do run } +C PR libfortran/31618 - backspace after an error didn't work. + program main + character*78 msg + open (21, file="backspace_7.dat", form="unformatted") + write (21) 42, 43 + write (21) 4711, 4712 + write (21) -1, -4 + rewind (21) + read (21) i,j + read (21,err=100,end=100) i,j,k + call abort + 100 continue + backspace 21 + read (21) i,j + if (i .ne. 4711 .or. j .ne. 4712) call abort + close (21,status="delete") + end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 74ba4e0..d682fc1 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2007-04-23 Thomas Koenig + + PR fortran/31618 + * io/transfer.c (read_block_direct): Instead of calling us_read, + set dtp->u.p.current_unit->current_record = 0 so that pre_position + will read the record marker. + (data_transfer_init): For different error conditions, call + generate_error, then return. + 2007-04-19 Francois-Xavier Coudert * runtime/main.c (please_free_exe_path_when_done): New variable. diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 65d83ef..f9f6657 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -494,11 +494,11 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) } else { - /* Let's make sure the file position is correctly set for the - next read statement. */ + /* Let's make sure the file position is correctly pre-positioned + for the next read statement. */ + dtp->u.p.current_unit->current_record = 0; next_record_r_unf (dtp, 0); - us_read (dtp, 0); generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL); return; } @@ -1769,15 +1769,18 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) /* Check the action. */ if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE) - generate_error (&dtp->common, ERROR_BAD_ACTION, - "Cannot read from file opened for WRITE"); + { + generate_error (&dtp->common, ERROR_BAD_ACTION, + "Cannot read from file opened for WRITE"); + return; + } if (!read_flag && dtp->u.p.current_unit->flags.action == ACTION_READ) - generate_error (&dtp->common, ERROR_BAD_ACTION, - "Cannot write to file opened for READ"); - - if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) - return; + { + generate_error (&dtp->common, ERROR_BAD_ACTION, + "Cannot write to file opened for READ"); + return; + } dtp->u.p.first_item = 1; @@ -1786,14 +1789,14 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if ((cf & IOPARM_DT_HAS_FORMAT) != 0) parse_format (dtp); - if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) - return; - if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED && (cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)) != 0) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "Format present for UNFORMATTED data transfer"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "Format present for UNFORMATTED data transfer"); + return; + } if ((cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0 && dtp->u.p.ionml != NULL) { @@ -1803,13 +1806,19 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) } else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && !(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT))) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "Missing format for FORMATTED data transfer"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "Missing format for FORMATTED data transfer"); + } if (is_internal_unit (dtp) && dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "Internal file cannot be accessed by UNFORMATTED data transfer"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "Internal file cannot be accessed by UNFORMATTED " + "data transfer"); + return; + } /* Check the record or position number. */ @@ -1839,49 +1848,71 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (dtp->u.p.advance_status != ADVANCE_UNSPECIFIED) { if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "ADVANCE specification conflicts with sequential access"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "ADVANCE specification conflicts with sequential access"); + return; + } if (is_internal_unit (dtp)) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "ADVANCE specification conflicts with internal file"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "ADVANCE specification conflicts with internal file"); + return; + } if ((cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)) != IOPARM_DT_HAS_FORMAT) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "ADVANCE specification requires an explicit format"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "ADVANCE specification requires an explicit format"); + return; + } } if (read_flag) { if ((cf & IOPARM_EOR) != 0 && dtp->u.p.advance_status != ADVANCE_NO) - generate_error (&dtp->common, ERROR_MISSING_OPTION, - "EOR specification requires an ADVANCE specification of NO"); + { + generate_error (&dtp->common, ERROR_MISSING_OPTION, + "EOR specification requires an ADVANCE specification " + "of NO"); + return; + } if ((cf & IOPARM_DT_HAS_SIZE) != 0 && dtp->u.p.advance_status != ADVANCE_NO) - generate_error (&dtp->common, ERROR_MISSING_OPTION, - "SIZE specification requires an ADVANCE specification of NO"); - + { + generate_error (&dtp->common, ERROR_MISSING_OPTION, + "SIZE specification requires an ADVANCE specification of NO"); + return; + } } else { /* Write constraints. */ if ((cf & IOPARM_END) != 0) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "END specification cannot appear in a write statement"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "END specification cannot appear in a write statement"); + return; + } if ((cf & IOPARM_EOR) != 0) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "EOR specification cannot appear in a write statement"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "EOR specification cannot appear in a write statement"); + return; + } if ((cf & IOPARM_DT_HAS_SIZE) != 0) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, - "SIZE specification cannot appear in a write statement"); + { + generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + "SIZE specification cannot appear in a write statement"); + return; + } } if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED) dtp->u.p.advance_status = ADVANCE_YES; - if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) - return; /* Sanity checks on the record number. */ if ((cf & IOPARM_DT_HAS_REC) != 0)