From patchwork Thu Jul 28 20:11:57 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 277 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:6a10:b5d6:b0:2b9:3548:2db5 with SMTP id v22csp434986pxt; Thu, 28 Jul 2022 13:13:02 -0700 (PDT) X-Google-Smtp-Source: AGRyM1t45wFdhJWVCJVYyXSo/ms/3/E5uTUefzKnBZPHD8jv0VPbYmABmEGMxdySyWq02LKUTiN+ X-Received: by 2002:a17:907:69b0:b0:72b:8e7b:6c2c with SMTP id ra48-20020a17090769b000b0072b8e7b6c2cmr422981ejc.61.1659039182263; Thu, 28 Jul 2022 13:13:02 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1659039182; cv=none; d=google.com; s=arc-20160816; b=wJhk9tkEIapQIllPb3IXl9bYN+BlS9RrS83WGjKOHraowc9jVVg8vT6qz7YfBpxuBz guh7eST7Dw+37YyOXpelojIZypkphaaAKWqMcMZaIF/+ciSU5OQKMgNJ12Cpjp6hvUi7 d45dh6RbJAZVEcALmVS94MAgQMG/2xlQbbGbSCnrJsgHv4rPfxBQXDIJOmDURa0P4eG8 Xx8DyLcqM90MwUXJLr0RfSciWCQk67Pt7k9xpoa8ifTTThPWWQLUS8NEqKH38a2HknOu y4LRbSj9S2uyfQ3/KQAwOcCHOeIlYzrbQ6zFTMvPk5QdBG19FRRduafDicanwk5sehVp 3T0A== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:sensitivity :importance:date:subject:to:message-id:mime-version:dmarc-filter :delivered-to:dkim-signature:dkim-filter; bh=MO9BL9AvZo2Gg2mwpsuNrcRmg2yBDApClO96cP6uQVc=; b=KC8SXasyBX7IG2yEjvw8g2JgT4qbiXMHlNGevoAn46nPzMAkGlw/+aQRtgoSEOfDn4 lV61XA0AZ2jm9z8nbNeLXOJwlNW0mONVuLx07Qmv+vdfDqgDH+9jN5MosIIEnPAL31/T W5qxpPLDLzzuqcwrvNxQ0pfbWJP+eZ9/iLIgGx4z7w9LacCOGrswaoSFkgL75XPls09T Ka35yWvHb8jp6n6bVMX8DyHS5tx2izYB8UCQzEN19cz8AmCtK2S9YZ3LH+eI1a0wB8wQ p63xQ4HEKg5QpBliAXFcmtCcH+3BaJufQ7qiit+iNfo3ZqYnsE3D6UIvYcAnb3Hd/uhe ZfgQ== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=xCDYYPkb; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id ss2-20020a170907c00200b0072b53c6b384si1152718ejc.246.2022.07.28.13.13.01 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 28 Jul 2022 13:13:02 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=xCDYYPkb; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id DD7B93857C45 for ; Thu, 28 Jul 2022 20:12:59 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DD7B93857C45 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1659039179; bh=MO9BL9AvZo2Gg2mwpsuNrcRmg2yBDApClO96cP6uQVc=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=xCDYYPkb8cl77gR0at67PvLlT4g34Nxk2oBxxMpjdts1VL2dywWhi8+o0c+QPmZKm lftDY//4aWvctqPpB49edMJvm885VTi1QXnFHoJf/eYn+XX9I8hoyAVPg42EcIOlKr uMsLYAH/q5rG+051pDL7m5FntqGquu9VxiH7YzK4= 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 B4F4C3858D33; Thu, 28 Jul 2022 20:11:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org B4F4C3858D33 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.14.154] ([79.251.14.154]) by web-mail.gmx.net (3c-app-gmx-bap60.server.lan [172.19.172.130]) (via HTTP); Thu, 28 Jul 2022 22:11:57 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: detect blanks within literal constants in free-form mode [PR92805] Date: Thu, 28 Jul 2022 22:11:57 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:zgfo/s0stYgb1lpxPNtXNx+UNhp2Ouhhg6R2QSeR9vCcJorT33fYNyXlxdSpgu9HUN96h /16u9BYciqArjZ2zyjsikQSJYjioKLG6QCvi+HEZ71WeypC8h6K+AR+vMx96Q9Ddx+ZPVNsL/P9m ITr2Vz3o1MgMo9PU5dApAvEo3Fn/ZSYvJ2BrFfux6xtIRuMKRxwklZq1ilURhbWNedItkPD3VNtO f9acbBH2o95qXYuxKK2PM8G11bapF39eKXxzBO8OPzVC8F2qVlvrpTDiCvPRlTQfehcKQRHOFca4 Yg= X-UI-Out-Filterresults: notjunk:1;V03:K0:eIP51ROItNM=:4GlKQcA8BwxJLpoSqbwVlu 4VVBaeuVmE37MLan+7LSTjRIKCh9XjOZP+qcBOF3LhvgPOla7OQ2ieODYoBT3LMaHZrLvveY9 YW87MxlWZ1+84sv5Q+TvjHENXoTZmzhPcAVgV5k0/yQQNQKUVwIb+2Hp7XMZ58SbxPgLD4aUZ Ys0XM7GNcbx2kWEfHjMnFJC9k7KIjLWucYVvVTPGYmmslycpWovrEOhsP8CRzXA8qh08SbsAJ inod9/W8hY1kYgtdUqOjLLT3gb2Wbdwnok4JwqWEOA7bT0VYBlr4xaOp1y+fEz/pBIuu3GvX/ DEVHZ5gabBerqcFCCj554nTohpDS5X1d0j8y1NEcv5lbYIAAvouIuOsn3oFxkkBt7Ky6vydTA /OWXwOdztk7BpCmfhoq6X3tSVNyEzNZ4doIO2gU/RVQTd6+JWtX5xresmmD97eaR07Ox7igd/ ODgKWZNy6zB/L7FW3Es0PKIJvoY9/DUfTSDCB2bjooBFVvFK7wK5gO3ta+Dc5a/7EEFWdlFaH hDXSkGZfjPcp3PeOjILwVvhcfXqt+7SBVaWLKFL3G5KJ0CML5kU8CElaYS6pV/gOJcZJ5m9Bp wxZ+5v6rToRzZN8wka9czzjyRx2OebtIm6qfI3R9Ctmqq4VqE1LJzhkfy/+9Fu4/JnShAsZwX l4nxkXRI6sufLEAxG2A6l46I4KDuxw631unGXEU2mHdoGYomx1L1cgEZEMrdq4vRlmEjr+4ja E6hahYwc8I13/ghp88DxpyZfgqGfWB0gO7yZmRHIYvpSIO21doCDG0QalW+rI595OF3ZugavE oOEWIQd 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.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1739628669326825900?= X-GMAIL-MSGID: =?utf-8?q?1739628669326825900?= Dear all, in free-form mode, blanks are significant, so they cannot appear in literal constants, especially not before or after the "_" that separates the literal and the kind specifier. The initial patch from Steve addressed numerical literals, which I completed by adjusting the parsing of string literals. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From f58c00f5792d6ec0037696df733857580a029ba9 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 28 Jul 2022 22:07:02 +0200 Subject: [PATCH] Fortran: detect blanks within literal constants in free-form mode [PR92805] gcc/fortran/ChangeLog: PR fortran/92805 * primary.cc (get_kind): Do not skip over blanks in free-form mode. (match_string_constant): Likewise. gcc/testsuite/ChangeLog: PR fortran/92805 * gfortran.dg/literal_constants.f: New test. * gfortran.dg/literal_constants.f90: New test. Co-authored-by: Steven G. Kargl --- gcc/fortran/primary.cc | 18 ++++++++++++-- gcc/testsuite/gfortran.dg/literal_constants.f | 20 ++++++++++++++++ .../gfortran.dg/literal_constants.f90 | 24 +++++++++++++++++++ 3 files changed, 60 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f90 diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 3f01f67cd49..9d200cdf65b 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -92,14 +92,21 @@ get_kind (int *is_iso_c) { int kind; match m; + char c; *is_iso_c = 0; + c = gfc_peek_ascii_char (); + if (gfc_current_form == FORM_FREE && gfc_is_whitespace (c)) + return -2; + if (gfc_match_char ('_') != MATCH_YES) return -2; - m = match_kind_param (&kind, is_iso_c); - if (m == MATCH_NO) + m = MATCH_NO; + c = gfc_peek_ascii_char (); + if ((gfc_current_form == FORM_FREE && gfc_is_whitespace (c)) + || (m = match_kind_param (&kind, is_iso_c)) == MATCH_NO) gfc_error ("Missing kind-parameter at %C"); return (m == MATCH_YES) ? kind : -1; @@ -1074,6 +1081,9 @@ match_string_constant (gfc_expr **result) c = gfc_next_char (); } + if (gfc_current_form == FORM_FREE && gfc_is_whitespace (c)) + goto no_match; + if (c == ' ') { gfc_gobble_whitespace (); @@ -1083,6 +1093,10 @@ match_string_constant (gfc_expr **result) if (c != '_') goto no_match; + c = gfc_peek_ascii_char (); + if (gfc_current_form == FORM_FREE && gfc_is_whitespace (c)) + goto no_match; + gfc_gobble_whitespace (); c = gfc_next_char (); diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f b/gcc/testsuite/gfortran.dg/literal_constants.f new file mode 100644 index 00000000000..4d1f1b7eb4c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/literal_constants.f @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-options "-ffixed-form" } +! PR fortran/92805 - blanks within literal constants in fixed-form mode + + implicit none + integer, parameter :: ck = kind ("a") ! default character kind + integer, parameter :: rk = kind (1.0) ! default real kind + print *, 1_"abc" + print *, 1 _"abc" + print *, 1_ "abc" + print *, ck_"a" + print *, ck _"ab" + print *, ck_ "ab" + print *, 3.1415_4 + print *, 3.1415 _4 + print *, 3.1415_ 4 + print *, 3.1415_rk + print *, 3.1415 _rk + print *, 3.1415_ rk + end diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f90 b/gcc/testsuite/gfortran.dg/literal_constants.f90 new file mode 100644 index 00000000000..f8908f9ad76 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/literal_constants.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-ffree-form" } +! PR fortran/92805 - blanks within literal constants in free-form mode + + implicit none + integer, parameter :: ck = kind ("a") ! default character kind + integer, parameter :: rk = kind (1.0) ! default real kind + print *, 1_"abc" + print *, 1 _"abc" ! { dg-error "Syntax error" } + print *, 1_ "abc" ! { dg-error "Missing kind-parameter" } + print *, 1 _ "abc" ! { dg-error "Syntax error" } + print *, ck_"a" + print *, ck _"ab" ! { dg-error "Syntax error" } + print *, ck_ "ab" ! { dg-error "Syntax error" } + print *, ck _ "ab" ! { dg-error "Syntax error" } + print *, 3.1415_4 + print *, 3.1415 _4 ! { dg-error "Syntax error" } + print *, 3.1415_ 4 ! { dg-error "Missing kind-parameter" } + print *, 3.1415 _ 4 ! { dg-error "Syntax error" } + print *, 3.1415_rk + print *, 3.1415 _rk ! { dg-error "Syntax error" } + print *, 3.1415_ rk ! { dg-error "Missing kind-parameter" } + print *, 3.141 _ rk ! { dg-error "Syntax error" } + end -- 2.35.3