From patchwork Fri Jun 18 03:19:57 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 56100 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id CC935B7D5C for ; Fri, 18 Jun 2010 13:20:29 +1000 (EST) Received: (qmail 4168 invoked by alias); 18 Jun 2010 03:20:26 -0000 Received: (qmail 4151 invoked by uid 22791); 18 Jun 2010 03:20:25 -0000 X-SWARE-Spam-Status: No, hits=4.3 required=5.0 tests=AWL, BAYES_50, BOTNET, RCVD_IN_DNSWL_NONE, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from vms173009pub.verizon.net (HELO vms173009pub.verizon.net) (206.46.173.9) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 18 Jun 2010 03:20:18 +0000 Received: from [192.168.1.10] ([unknown] [64.234.92.14]) by vms173009.mailsrvcs.net (Sun Java(tm) System Messaging Server 7u2-7.02 32bit (built Apr 16 2009)) with ESMTPA id <0L4600C81X99TZB1@vms173009.mailsrvcs.net>; Thu, 17 Jun 2010 22:20:02 -0500 (CDT) Message-id: <4C1AE5DD.3040900@verizon.net> Date: Thu, 17 Jun 2010 20:19:57 -0700 From: Jerry DeLisle User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.1.9) Gecko/20100423 Thunderbird/3.0.4 MIME-version: 1.0 To: gfortran Cc: gcc patches Subject: [patch, libfortran] PR44477 Sequential I/O with END FILE: File position should be at EoF Content-type: multipart/mixed; boundary=------------010800000908050609090406 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Hi, This patch adds checks and issues errors if ENDFILE is executed when the file is already positioned after thee EOF marker. It also gives errors if a read or write is attempted when positioned after the EOF marker. Another problem is that ENDFILE should create the file if it does not exist. Regression tested on x86-64-gnu-linux. Test cases provided. OK for trunk? Regards, Jerry 2010-06-17 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. Index: file_pos.c =================================================================== --- file_pos.c (revision 160770) +++ file_pos.c (working copy) @@ -283,11 +283,20 @@ 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; + } + /* If there are previously written bytes from a write with ADVANCE="no", add a record marker before performing the ENDFILE. */ @@ -309,10 +318,51 @@ 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; + + /* Is it unformatted? */ + 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 (); } Index: transfer.c =================================================================== --- transfer.c (revision 160770) +++ transfer.c (working copy) @@ -2267,15 +2267,25 @@ data_transfer_init (st_parameter_dt *dtp, int read 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