From patchwork Thu Mar 28 13:48:27 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 232032 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]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id B197E2C007C for ; Fri, 29 Mar 2013 00:49:23 +1100 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=jjcnu6TMHTncLpu505gdv/gewh/wdclD22lv25LRTjfThM SMdV6cV7rj0CDImM5OAqUHqySjcBHMAPaDsh0XIvvZf+qLgWVuQp72StxErwJFRN Ap0X9MQEppYOccoTV7y+fBeT6t7oZgYqregSH+VjeVe0Gk7bVhXi11vF1nKYg= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=YIfJl/XtDrh1iVbJ3JlDCPhdREM=; b=A4UxUTHlt2RwxUgm21W1 ZkCeXVafxZA5uA9EbWLsuaTwcr30YXMFqhUAZpCwV+NavJUe3O5yNTYp6E0idNzY Pmas094yJiLWI81Us1MxCLXPq44l3ugK1len95kWx8Fdpp+LJ8hZIoUt4X8hsKzf WOaqogUuBLrOPkleVfuSjfI= Received: (qmail 8904 invoked by alias); 28 Mar 2013 13:48:43 -0000 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 Received: (qmail 8693 invoked by uid 89); 28 Mar 2013 13:48:36 -0000 X-Spam-SWARE-Status: No, score=-2.1 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, TW_CP autolearn=ham version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Thu, 28 Mar 2013 13:48:32 +0000 Received: from archimedes.net-b.de (port-92-195-88-1.dynamic.qsc.de [92.195.88.1]) by mx01.qsc.de (Postfix) with ESMTP id 0FBA43CF85; Thu, 28 Mar 2013 14:48:28 +0100 (CET) Message-ID: <51544A2B.2010608@net-b.de> Date: Thu, 28 Mar 2013 14:48:27 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130307 Thunderbird/17.0.4 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR56735 - Fix namelist read regression with "?" X-Virus-Found: No gfortran supports "?" and "=?" as input with namelists (a somewhat common vendor extension). Either of those can be used with stdin to print the available fields of the namelist. With non-stdin input, the ? and =? lines are simply ignored. However, two patches, one in 2008 and one in 2011 broke that feature. The first one broke the output of the namelist with stdin, the second caused that the namelist read is aborted (with iostat == 0) - and the namelist ist not read. The attached patch fixes this. GCC 4.6 to 4.9 are affected by the latter issue (for which the PR has been filled). The other issue affects 4.5 to 4.9 and only applies to stdin input, for which no output is shown when using "?". Build and regtested on x86-64-gnu-linux. OK for the trunk - and for GCC 4.6 to 4.8? Tobias 2013-03-28 Tobias Burnus PR fortran/56735 * io/list_read.c (nml_query): Only abort when an error occured. (namelist_read): Add goto instead of falling through. 2013-03-28 Tobias Burnus PR fortran/56735 * gfortran.dg/namelist_80.f90: New. diff --git a/gcc/testsuite/gfortran.dg/namelist_80.f90 b/gcc/testsuite/gfortran.dg/namelist_80.f90 new file mode 100644 index 0000000..1961b11 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_80.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! +! PR fortran/56735 +! +! Contributed by Adam Williams +! + PROGRAM TEST + INTEGER int1,int2,int3 + NAMELIST /temp/ int1,int2,int3 + + int1 = -1; int2 = -2; int3 = -3 + + OPEN (53, STATUS='scratch') + WRITE (53, '(a)') ' ?' + WRITE (53, '(a)') + WRITE (53, '(a)') '$temp' + WRITE (53, '(a)') ' int1=1' + WRITE (53, '(a)') ' int2=2' + WRITE (53, '(a)') ' int3=3' + WRITE (53, '(a)') '$END' + REWIND(53) + + READ (53, temp) + CLOSE (53) + + if (int1 /= 1 .or. int2 /= 2 .or. int3 /= 3) call abort() + END PROGRAM diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index ec45570..7ce727d 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2380,11 +2380,11 @@ nml_query (st_parameter_dt *dtp, char c) index_type len; char * p; #ifdef HAVE_CRLF - static const index_type endlen = 3; + static const index_type endlen = 2; static const char endl[] = "\r\n"; static const char nmlend[] = "&end\r\n"; #else - static const index_type endlen = 2; + static const index_type endlen = 1; static const char endl[] = "\n"; static const char nmlend[] = "&end\n"; #endif @@ -2414,12 +2414,12 @@ nml_query (st_parameter_dt *dtp, char c) /* "&namelist_name\n" */ len = dtp->namelist_name_len; - p = write_block (dtp, len + endlen); + p = write_block (dtp, len - 1 + endlen); if (!p) goto query_return; memcpy (p, "&", 1); memcpy ((char*)(p + 1), dtp->namelist_name, len); - memcpy ((char*)(p + len + 1), &endl, endlen - 1); + memcpy ((char*)(p + len + 1), &endl, endlen); for (nl = dtp->u.p.ionml; nl; nl = nl->next) { /* " var_name\n" */ @@ -2430,14 +2430,15 @@ nml_query (st_parameter_dt *dtp, char c) goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); - memcpy ((char*)(p + len + 1), &endl, endlen - 1); + memcpy ((char*)(p + len + 1), &endl, endlen); } /* "&end\n" */ - p = write_block (dtp, endlen + 3); + p = write_block (dtp, endlen + 4); + if (!p) goto query_return; - memcpy (p, &nmlend, endlen + 3); + memcpy (p, &nmlend, endlen + 4); } /* Flush the stream to force immediate output. */ @@ -3072,6 +3073,7 @@ find_nml_name: case '?': nml_query (dtp, '?'); + goto find_nml_name; case EOF: return;