From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 8930 invoked by alias); 7 Mar 2013 16:35:27 -0000 Received: (qmail 8855 invoked by uid 22791); 7 Mar 2013 16:35:26 -0000 X-SWARE-Spam-Status: No, hits=-3.1 required=5.0 tests=AWL,BAYES_00,KHOP_THREADED,RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mo-p00-ob.rzone.de (HELO mo-p00-ob.rzone.de) (81.169.146.161) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 07 Mar 2013 16:35:19 +0000 X-RZG-AUTH: :IW0NeWC8cvPlgn0IPTehqi9r6o/0DSXjJ1Me0yWdPTUrUVR1S8XZdqdiwD8d+ZN9r2I= X-RZG-CLASS-ID: mo00 Received: from dellschleppa.fritz.box (p5DD0717C.dip.t-dialin.net [93.208.113.124]) by smtp.strato.de (jorabe mo25) (RZmta 31.19 DYNA|AUTH) with ESMTPA id 203529p27GKZNB ; Thu, 7 Mar 2013 17:35:17 +0100 (CET) Content-Type: multipart/mixed; boundary=----------9YE7gz6OsPd1x1du7YOPSD To: "Tobias Burnus" Cc: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: Re: [Patch, libfortran, 2nd version] PR 48618 - Negative unit number in OPEN(...) is sometimes allowed References: <51387E02.60403@net-b.de> Date: Thu, 07 Mar 2013 16:35:00 -0000 MIME-Version: 1.0 From: "Tilo Schwarz" Message-ID: In-Reply-To: <51387E02.60403@net-b.de> User-Agent: Opera Mail/12.14 (Linux) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2013-03/txt/msg00304.txt.bz2 ------------9YE7gz6OsPd1x1du7YOPSD Content-Type: text/plain; charset=utf-8; format=flowed; delsp=yes Content-Transfer-Encoding: 8bit Content-length: 720 On Thu, 07 Mar 2013 12:46:10 +0100, Tobias Burnus wrote: > Hi, > > Tilo Schwarz wrote: >> this patch fixes PR 48618. >> Built and regtested on Linux 3.2.0-4-686-pae. > > Thanks for the patch, which mostly looks okay. > > A few remarks: Thank you for the feedback. I incorporated all remarks into the new attached patch. > * Copyright assignment: You mentioned that you have emailed(§) the form > back to the FSF. Was this the actual copyright-assignment form which the > FSF sent to you by mail? Or was it 'only' request form? It was the actual copyright-assignment form. > Can you tell us, > when the FSF has acknowledged the arrival of the copyright assignment? Yes, I'll do. Regards, Tilo ------------9YE7gz6OsPd1x1du7YOPSD Content-Disposition: attachment; filename=negative_unit.diff Content-Type: text/diff; name=negative_unit.diff Content-Transfer-Encoding: 8bit Content-length: 2182 2013-03-06 Tilo Schwarz PR libfortran/48618 * io/open.c (st_open): Raise error for unit number < 0 only if unit number does not exist already. * gcc/testsuite/gfortran.dg/open_negative_unit_1.f90: New. diff --git a/gcc/testsuite/gfortran.dg/open_negative_unit_1.f90 b/gcc/testsuite/gfortran.dg/open_negative_unit_1.f90 new file mode 100644 index 0000000..6446436 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/open_negative_unit_1.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! PR48618 - Negative unit number in OPEN(...) is sometimes allowed +! +! Test originally from Janne Blomqvist in PR: +! http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48618 + +program nutest + implicit none + integer id, ios + + open(newunit=id, file="foo.txt", iostat=ios) + if (ios /= 0) call abort + + open(id, file="bar.txt", iostat=ios) + if (ios /= 0) call abort + + close(id, status="delete") + + open(-10, file="foo.txt", iostat=ios) + if (ios == 0) call abort +end program nutest diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index d9cfde8..19fab1d 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -818,10 +818,6 @@ st_open (st_parameter_open *opp) flags.convert = conv; - if (!(opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT) && opp->common.unit < 0) - generate_error (&opp->common, LIBERROR_BAD_OPTION, - "Bad unit number in OPEN statement"); - if (flags.position != POSITION_UNSPECIFIED && flags.access == ACCESS_DIRECT) generate_error (&opp->common, LIBERROR_BAD_OPTION, @@ -848,8 +844,16 @@ st_open (st_parameter_open *opp) { if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT)) opp->common.unit = get_unique_unit_number(opp); + else if (opp->common.unit < 0) + { + u = find_unit (opp->common.unit); + if (u == NULL) /* Negative unit and no NEWUNIT-created unit found. */ + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Bad unit number in OPEN statement"); + } - u = find_or_create_unit (opp->common.unit); + if (u == NULL) + u = find_or_create_unit (opp->common.unit); if (u->s == NULL) { u = new_unit (opp, u, &flags); ------------9YE7gz6OsPd1x1du7YOPSD--