From b9983d610a1d08f2acc105f15bd7dafe293104e4 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sat, 19 Jun 2010 00:58:28 +0000 Subject: [PATCH] re PR fortran/44477 (Sequential I/O with END FILE: File position should be at EoF) 2010-06-18 Jerry DeLisle PR libfortran/44477 * io/file_pos.c (st_endfile): Add check for ENDFILE when file is already positioned after the EOF marker. Use find_or_create_unit instead of find_unit. If unit is not connected, connect it and create the file with default settings. * io/transfer.c (data_transfer_init): Add check for attempted READ or WRITE when file is already positioned after the EOF marker. From-SVN: r161020 --- libgfortran/ChangeLog | 10 +++++++ libgfortran/io/file_pos.c | 57 ++++++++++++++++++++++++++++++++++++--- libgfortran/io/transfer.c | 24 ++++++++++++----- 3 files changed, 80 insertions(+), 11 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 946168c253a..83ff864a5ff 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2010-06-18 Jerry DeLisle + + PR libfortran/44477 + * io/file_pos.c (st_endfile): Add check for ENDFILE when file is + already positioned after the EOF marker. Use find_or_create_unit + instead of find_unit. If unit is not connected, connect it and create + the file with default settings. + * io/transfer.c (data_transfer_init): Add check for attempted READ or + WRITE when file is already positioned after the EOF marker. + 2010-06-10 Francois-Xavier Coudert * intrinsics/selected_char_kind.c (selected_char_kind): Fix diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index f7d94996163..e7fbab4c8cc 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -283,8 +283,17 @@ st_endfile (st_parameter_filepos *fpp) if (u->flags.access == ACCESS_DIRECT) { generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, - "Cannot perform ENDFILE on a file opened" - " for DIRECT access"); + "Cannot perform ENDFILE on a file opened " + "for DIRECT access"); + goto done; + } + + if (u->flags.access == ACCESS_SEQUENTIAL + && u->endfile == AFTER_ENDFILE) + { + generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, + "Cannot perform ENDFILE on a file already " + "positioned after the EOF marker"); goto done; } @@ -309,9 +318,49 @@ st_endfile (st_parameter_filepos *fpp) u->endfile = AFTER_ENDFILE; if (0 == stell (u->s)) u->flags.position = POSITION_REWIND; - done: - unlock_unit (u); } + else + { + if (fpp->common.unit < 0) + { + generate_error (&fpp->common, LIBERROR_BAD_OPTION, + "Bad unit number in statement"); + return; + } + + u = find_or_create_unit (fpp->common.unit); + if (u->s == NULL) + { + /* Open the unit with some default flags. */ + st_parameter_open opp; + unit_flags u_flags; + + memset (&u_flags, '\0', sizeof (u_flags)); + u_flags.access = ACCESS_SEQUENTIAL; + u_flags.action = ACTION_READWRITE; + u_flags.form = FORM_UNSPECIFIED; + u_flags.delim = DELIM_UNSPECIFIED; + u_flags.blank = BLANK_UNSPECIFIED; + u_flags.pad = PAD_UNSPECIFIED; + u_flags.decimal = DECIMAL_UNSPECIFIED; + u_flags.encoding = ENCODING_UNSPECIFIED; + u_flags.async = ASYNC_UNSPECIFIED; + u_flags.round = ROUND_UNSPECIFIED; + u_flags.sign = SIGN_UNSPECIFIED; + u_flags.status = STATUS_UNKNOWN; + u_flags.convert = GFC_CONVERT_NATIVE; + + opp.common = fpp->common; + opp.common.flags &= IOPARM_COMMON_MASK; + u = new_unit (&opp, u, &u_flags); + if (u == NULL) + return; + u->endfile = AFTER_ENDFILE; + } + } + + done: + unlock_unit (u); library_end (); } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 982d7d0b433..9f2aafaf1a4 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -2267,15 +2267,25 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) return; } - if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL - && (cf & IOPARM_DT_HAS_REC) != 0) + if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) { - generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, - "Record number not allowed for sequential access " - "data transfer"); - return; - } + if ((cf & IOPARM_DT_HAS_REC) != 0) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Record number not allowed for sequential access " + "data transfer"); + return; + } + if (dtp->u.p.current_unit->endfile == AFTER_ENDFILE) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Sequential READ or WRITE not allowed after " + "EOF marker, possibly use REWIND or BACKSPACE"); + return; + } + + } /* Process the ADVANCE option. */ dtp->u.p.advance_status -- 2.30.2