From patchwork Sun Oct 30 03:30:46 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 80064 Delivered-To: patch@linaro.org Received: by 10.140.97.247 with SMTP id m110csp1866137qge; Sat, 29 Oct 2016 20:32:26 -0700 (PDT) X-Received: by 10.99.97.15 with SMTP id v15mr31672457pgb.10.1477798346058; Sat, 29 Oct 2016 20:32:26 -0700 (PDT) Return-Path: Received: from sourceware.org (server1.sourceware.org. [209.132.180.131]) by mx.google.com with ESMTPS id p84si19296345pfk.119.2016.10.29.20.32.25 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sat, 29 Oct 2016 20:32:26 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-return-439900-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) client-ip=209.132.180.131; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org; spf=pass (google.com: domain of gcc-patches-return-439900-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) smtp.mailfrom=gcc-patches-return-439900-patch=linaro.org@gcc.gnu.org DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to:cc :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=by8WLWBjTs2PaI0vtIHfLXIL7n8/jFez9723e/akC7ubJGTYoB Iu1DTnZjTKWMlSu9NYgKQ6jneYzWMVo8v9SJ2CwLTFj9GplhkMoma4MqGvGlq6bG OX5jaemGLXcDJY5ta6bZY9nkF1o3mOZfdMqMqlY1M3qx/vOBqm+/wbUW8= 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:to:cc :from:subject:message-id:date:mime-version:content-type; s= default; bh=HdbacN56nrQVWP+B6YMuqokyeSU=; b=BqDf2E6dmXRrZSDG8Jih CaUYLLVU+FcQZhMMaXMtY98p9kUxQeBkL09uVUxHmo5uuwvyLqCy1XpPrwKoE0Xs HRjskuu0J2N+meIJEk48BovjQUvz0PVOzv3evzEMfdhE2VLn7cbmqt5dN2F7NLuH tnJT/DFoKVTaDJnVVLajulo= Received: (qmail 60361 invoked by alias); 30 Oct 2016 03:32:04 -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 59549 invoked by uid 89); 30 Oct 2016 03:31:00 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-3.3 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 spammy=un, u.n, jvdelisle@gcc.gnu.org, jvdelislegccgnuorg X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout001-public.msg.strl.va.charter.net Received: from mtaout001-public.msg.strl.va.charter.net (HELO mtaout001-public.msg.strl.va.charter.net) (68.114.190.26) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 30 Oct 2016 03:30:50 +0000 Received: from impout003 ([68.114.189.18]) by mtaout001.msg.strl.va.charter.net (InterMail vM.9.00.023.01 201-2473-194) with ESMTP id <20161030033048.GFPE7355.mtaout001.msg.strl.va.charter.net@impout003>; Sat, 29 Oct 2016 22:30:48 -0500 Received: from amda8.localdomain ([96.41.215.23]) by impout003 with charter.net id 1fWn1u0040Wrkg001fWnlL; Sat, 29 Oct 2016 22:30:48 -0500 X-Authority-Analysis: v=2.1 cv=CvwxcxID c=1 sm=1 tr=0 a=salB9WdMPIDduBH7JsZfrA==:117 a=salB9WdMPIDduBH7JsZfrA==:17 a=L9H7d07YOLsA:10 a=9cW_t1CCXrUA:10 a=s5jvgZ67dGcA:10 a=r77TgQKjGQsHNAKrUKIA:9 a=mDV3o1hIAAAA:8 a=FVqUHJhdkH2N3uHmPSoA:9 a=QEXdDO2ut3YA:10 a=ZLYoCh3qviq4eV8d6aIA:9 a=NDLRfOgF9gca8-TU:21 a=MPEiZ2zaA32TL4i-:21 a=_FVE-zBwftR9WsbkzFJk:22 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 To: "fortran@gcc.gnu.org" Cc: GCC Patches From: Jerry DeLisle Subject: [Patch, fortran] PR54679 Erroneous "Expected P edit descriptor" in conjunction with L descriptor Message-ID: <04fe3001-358c-ec54-1d76-89f7589e1214@charter.net> Date: Sat, 29 Oct 2016 20:30:46 -0700 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:45.0) Gecko/20100101 Thunderbird/45.4.0 MIME-Version: 1.0 Hi All, Gfortran currently treats an L format descriptor with no width as an extension. When the width is zero (not a positive integer) the error message was confused. The checking software was saving the format token, FMT_ZERO, for the next round of checks and this was interpreted to be a zero preceding a P edit descriptor. This is fixed by adding the check for FMT_ZERO explicitly. I also added diagnostic messages to better explain the error. L0 is also allowed now as an extension. Regression tested on x86-64-linux. New test case included in patch as well as adjusting the text for fmt_l.f90 OK for trunk? Jerry 2016-10-29 Jerry DeLisle PR fortran/54679 * io.c (check_format): Adjust checks for FMT_L to treat a zero width as an extension, giving warnings or error as appropriate. Improve messages. 2016-10-24 Jerry DeLisle PR fortran/54679 * io/format.c (parse_format_list): Adjust checks for FMT_L to treat a zero width as an extension, giving warnings or error as appropriate. Improve messages. diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 7c48c491..0f81048a 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -592,7 +592,7 @@ check_format (bool is_input) const char *unexpected_end = _("Unexpected end of format string"); const char *zero_width = _("Zero width in format descriptor"); - const char *error; + const char *error = NULL; format_token t, u; int level; int repeat; @@ -858,27 +858,31 @@ data_desc: goto fail; if (t == FMT_POSINT) break; - - switch (gfc_notification_std (GFC_STD_GNU)) + if (mode != MODE_FORMAT) + format_locus.nextc += format_string_pos; + if (t == FMT_ZERO) { - case WARNING: - if (mode != MODE_FORMAT) - format_locus.nextc += format_string_pos; - gfc_warning (0, "Extension: Missing positive width after L " - "descriptor at %L", &format_locus); - saved_token = t; - break; - - case ERROR: - error = posint_required; - goto syntax; - - case SILENT: - saved_token = t; - break; - - default: - gcc_unreachable (); + switch (gfc_notification_std (GFC_STD_GNU)) + { + case WARNING: + gfc_warning (0, "Extension: Zero width after L " + "descriptor at %L", &format_locus); + break; + case ERROR: + gfc_error ("Extension: Zero width after L " + "descriptor at %L", &format_locus); + goto fail; + case SILENT: + break; + default: + gcc_unreachable (); + } + } + else + { + saved_token = t; + gfc_notify_std (GFC_STD_GNU, "Missing positive width after " + "L descriptor at %L", &format_locus); } break; diff --git a/gcc/testsuite/gfortran.dg/fmt_l.f90 b/gcc/testsuite/gfortran.dg/fmt_l.f90 index 9dc4f570..0fd19551 100644 --- a/gcc/testsuite/gfortran.dg/fmt_l.f90 +++ b/gcc/testsuite/gfortran.dg/fmt_l.f90 @@ -52,34 +52,34 @@ program test_l end program test_l ! { dg-output "At line 14 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 15 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 19 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 20 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 24 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 25 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 29 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 30 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 34 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 35 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 39 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 40 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 44 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 45 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 49 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } ! { dg-output "At line 50 of file.*" } -! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" } +! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" } diff --git a/gcc/testsuite/gfortran.dg/fmt_l0.f90 b/gcc/testsuite/gfortran.dg/fmt_l0.f90 new file mode 100644 index 00000000..fab1ffb1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_l0.f90 @@ -0,0 +1,12 @@ +! { dg-do run } +! { dg-options "-std=gnu -pedantic" } +! Test the GNU extension of a L format descriptor without width +! PR libfortran/54679 +program main + implicit none + character(len=20) :: str + character(len=60) :: format2 = "(2(1x,l0,1x))" + write(str,format2) +end program main +! { dg-output "At line 9 of file.*" } +! { dg-output "Fortran runtime warning: Zero width after L descriptor(\n|\r\n|\r)" } diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index 31bc6429..8a185974 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -870,19 +870,25 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd) t = format_lex (fmt); if (t != FMT_POSINT) { - if (notification_std(GFC_STD_GNU) == NOTIFICATION_ERROR) + if (t == FMT_ZERO) { - fmt->error = posint_required; - goto finished; + if (notification_std(GFC_STD_GNU) == NOTIFICATION_ERROR) + { + fmt->error = "Extension: Zero width after L descriptor"; + goto finished; + } + else + notify_std (&dtp->common, GFC_STD_GNU, + "Zero width after L descriptor"); } else { fmt->saved_token = t; - fmt->value = 1; /* Default width */ - notify_std (&dtp->common, GFC_STD_GNU, posint_required); + notify_std (&dtp->common, GFC_STD_GNU, + "Positive width required with L descriptor"); } + fmt->value = 1; /* Default width */ } - get_fnode (fmt, &head, &tail, FMT_L); tail->u.n = fmt->value; tail->repeat = repeat;