From patchwork Sun May 24 19:25:41 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1296943 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gmx.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; secure) header.d=gmx.net header.i=@gmx.net header.a=rsa-sha256 header.s=badeba3b8450 header.b=ibe2lHK8; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 49VVZ92Q5kz9sSF for ; Mon, 25 May 2020 05:25:51 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 53C67388B014; Sun, 24 May 2020 19:25:46 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.17.21]) by sourceware.org (Postfix) with ESMTPS id BE687385BF81; Sun, 24 May 2020 19:25:42 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org BE687385BF81 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=anlauf@gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1590348341; bh=sxFgD0gcwa1pRbnfW3QiB2JOmLivTnysmb4wYliSn8U=; h=X-UI-Sender-Class:From:To:Subject:Date; b=ibe2lHK8oMG7E6iN94riAzSVk85TLajsxGIxJEIkxCux5QxUJ6WrbSQL8p4INa+N5 /uqUIh+np7A9Gaf4+alJXW6B2jqY7hVVs+rAkbheovGy+o5VIcPyIBxxUIns6SWaec nCBSD+GWZkXkb20K2yVwy+yhQ1WbIXF8i+yV1ARs= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.232.152.205] ([79.232.152.205]) by web-mail.gmx.net (3c-app-gmx-bap50.server.lan [172.19.172.120]) (via HTTP); Sun, 24 May 2020 21:25:41 +0200 MIME-Version: 1.0 Message-ID: From: "Harald Anlauf" To: fortran , gcc-patches Subject: PR libfortran/95195 - improve runtime error for namelist i/o to unformatted file Date: Sun, 24 May 2020 21:25:41 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:0YkDsoBkFJTz4CANNqpfi54c3NPVxqhiVTroD6MEzZnbd63DOOFJsnlR92SCu1W4PrrIZ DHzqXBVFmWBITP28ev5ZBm6E79Mih9KmTJtTUP/Cre0rMA6gI21SErnAIGimRNwy3E5tTTJFSNcH 5q348vhpczHmiI4WiBTGm/oZ06BfEJ7d1nYJyp1LDFRizoz2derBgEZIB5UlejODCMRhCEPoSAtK IisgoCoylTv/LAmPqTpbIXV0C3CCUEbOJrZfcQjOT++3uaGNwCeXl6DiMzZ0EvS6lYI/s2pXKLdU y4= X-UI-Out-Filterresults: notjunk:1;V03:K0:nxA1FOHE0/s=:cnquWhBS/ILxyb8lyyb0TK 8QkLckUYJXjbDV6zaGae6ClsKxA8Zc4ci4zqbEbq82itJGir6cGkSS+AlNSbuql80cp1O77sw W22+6sxWD5qiOAXZGdZeNBnFCCWKnNLRuFUhW6TD+zwkkPEzNyOp+Y3sdfpyffP4OB/C4CMcf 4OCa51ENdb5dZXtgdpGH72T7pJsDPh8GBXD/lEXX+U+jbK5sVLUqVE1dnWrWUsnuG3zDU7gU+ /Zm2hAz2DovOEdT7jcUQW/Xn+DoLTUH4oKTgpXGWqs111iT4l/+pQ/mxKQctTjAzpvYENPeAe 7BZ24FolNP+pBIa4qlcKHNCflUA+jPCkLK/ibKv2mlxhBhlTRqD7QHLOu0Bk5+vzh8y8S65hx 4eOPV743ujXCPtjsEh5hXgQnKBx6gDPgrKFdSkN2hAQu2gn2BS9qrOHv+5OVxfH+ir2pK55ND beMJq3YP6WmzfXtwP+cAsELyOLvCF61nXV6S+SN92mgYt8bnKzt6hD5r49OwUTo19oznrYcnJ aEmeJKOLKvh/GrWeoBPYldjBqNKtCpmllxJsGjPsg+usupyjDRAusKKbavCbTYdFFL60AQJ+S FyecSMg0h+oWyf0Lu27pyXPsxBA/UUGK+m9W+5/A0qZLtjdCkMbvpTmrcsmRCCGML46YU6Q2r GWVsVBA4vuAYm+ejs0Kiv4R6G4veQAP5/egikGAkoPbAz7e1ld+1V8upeEc5ebuCaYNk= X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Without the patch below, an attempted namelist write to an unformatted file - which is prohibited by the standard - would generate the following runtime error: At line 12 of file pr95195.f90 (unit = 10, file = 'test.dat') Fortran runtime error: End of record followed by some backtrace. The patch attempts to generate an error pointing the user to the real issue. Regtested on x86_64-pc-linux-gnu. OK for master? Thanks, Harald PR libfortran/95195 - improve runtime error for namelist i/o to unformatted file Namelist input/output to unformatted files is prohibited. Generate useful runtime errors instead instead of misleading ones. libgfortran/ 2020-05-24 Harald Anlauf PR fortran/95195 * io/transfer.c (finalize_transfer): Generate runtime error for namelist input/output to unformatted file. gcc/testsuite/ 2020-05-24 Harald Anlauf PR fortran/95195 * gfortran.dg/namelist_97.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/namelist_97.f90 b/gcc/testsuite/gfortran.dg/namelist_97.f90 new file mode 100644 index 00000000000..4907e46b46a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_97.f90 @@ -0,0 +1,14 @@ +! { dg-do run } +! { dg-output "At line 12 .*" } +! { dg-shouldfail "Fortran runtime error: Namelist formatting .* FORM='UNFORMATTED'" } +! +! PR95195 - improve runtime error when writing a namelist to an unformatted file + +program test + character(len=11) :: my_form = 'unformatted' + integer :: i = 1, j = 2, k = 3 + namelist /nml1/ i, j, k + open (unit=10, file='test.dat', form=my_form) + write (unit=10, nml=nml1) + close (unit=10, status='delete') +end program test diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index b8db47dbff9..d071c1ce915 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -4123,6 +4123,14 @@ finalize_transfer (st_parameter_dt *dtp) if ((dtp->u.p.ionml != NULL) && (cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0) { + if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Namelist formatting for unit connected " + "with FORM='UNFORMATTED"); + return; + } + dtp->u.p.namelist_mode = 1; if ((cf & IOPARM_DT_NAMELIST_READ_MODE) != 0) namelist_read (dtp);