From patchwork Sat Jul 30 19:40:17 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 320 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:6a10:b5d6:b0:2b9:3548:2db5 with SMTP id v22csp1463263pxt; Sat, 30 Jul 2022 12:41:24 -0700 (PDT) X-Google-Smtp-Source: AGRyM1vExzrIXxqcuLm5+NKkoi/77NSk+zcZ1ex6TD2njj105eZsbWlphySyyaVpgnXZ3YlZoj0Q X-Received: by 2002:a17:907:2c68:b0:72b:3a2c:e5b5 with SMTP id ib8-20020a1709072c6800b0072b3a2ce5b5mr6988747ejc.619.1659210084523; Sat, 30 Jul 2022 12:41:24 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1659210084; cv=none; d=google.com; s=arc-20160816; b=LYdtFCnmfJhOxSKp3fyymEo22xffn04rnO+dMkZNyDCHASQX/qAaq4UL5t3IHuQ5bW oiy0g8+47KaihO5NgttZ5qFHL2p9Mv9x/ZdX/BWRmlHnde2Mvnoh0H3J6ay+hC4zaLc4 cghUuRMKKQyXn5s9Mhdy48j7DJ2w/DEn4u0kkTvGZ0700JsTRejZSvXsZVKylMoSRBbt H9T8qK5bVmp9ZUSXvcweu9xQyBosN/LO+jVYrGnfQJYP8bAfoD5ENwwFMsWoUT6cf3oP 4cuh00kH1rGHj4NKrRtZsWyz9IpU3Zis7d0qZxcETK8uameUgTuvZEjLctwstwwrWD51 00DQ== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:cc:reply-to:from:list-subscribe:list-help :list-post:list-archive:list-unsubscribe:list-id:precedence :in-reply-to:references:newsgroups:to:content-language:subject :user-agent:mime-version:date:message-id:dmarc-filter:delivered-to :dkim-signature:dkim-filter; bh=EP+fgu/mFotge4elhP8ukMFLwlOxqB1Z8PN5WzAHmy8=; b=zjHcqtVhuICY6Ostxy/NxBBLO16enlJ12Kcv22BWwXEgpAFlkfuFtY4wwRvPShg7Su bbsQOEo5Yz60nYvKu1+chRNDeqD/3tpQy0VJTQENWxA2I58e4T2kEz1acNBzsF3YOwuo 4rGc1dUl3aDvUnqMKGK9D1HXn23aSSwVeKx1DOwHz5Jk+wERO8XwwCSIbXXpOg8QJLSB gkHrDjDhd4nBDIK0uogKU+TpVWiIahnoBPCQahkmU7diBCvq4gD0kGLsMe9leZ0GgK22 DsNgCnRIZW7P3O96ZXKEop0Pkg3pVrKkjZVJoFliNWbwFPb7lpxeQZnEJCk3u2GZNfce Dngg== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=wDHYHeGA; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 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 (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id sb12-20020a1709076d8c00b006e7fe1e4eb4si4141635ejc.847.2022.07.30.12.41.24 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 30 Jul 2022 12:41:24 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=wDHYHeGA; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 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 76B18385276A for ; Sat, 30 Jul 2022 19:41:06 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 76B18385276A DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1659210066; bh=EP+fgu/mFotge4elhP8ukMFLwlOxqB1Z8PN5WzAHmy8=; h=Date:Subject:To:References:In-Reply-To:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To:Cc: From; b=wDHYHeGACqQy6eKoitOxr+scY59jcLKw3qQkNbN9sfgQnD0jayE22xy1OIddgdw5M io40GyN5UCJERAZ44vBqUgL2PRPzq6LA/9zeQeVrbyWtzO8WRAntoPYRkX83K3iMgz wRYtWK6eDal6W1sUI9T4KMm3xmRzaDHsBdXMuRq4= 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.15.15]) by sourceware.org (Postfix) with ESMTPS id A01383857C58; Sat, 30 Jul 2022 19:40:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org A01383857C58 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [192.168.178.29] ([79.251.6.25]) by mail.gmx.net (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MtfJd-1nSNlU1wGF-00vAyz; Sat, 30 Jul 2022 21:40:19 +0200 Message-ID: <1073012a-e384-77e6-6cc8-7069dabab862@gmx.de> Date: Sat, 30 Jul 2022 21:40:17 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.11.0 Subject: [PATCH, v4] Fortran: detect blanks within literal constants in free-form mode [PR92805] Content-Language: en-US To: Mikael Morin , fortran@gcc.gnu.org Newsgroups: gmane.comp.gcc.patches,gmane.comp.gcc.fortran References: <46cc765d-469e-d6e8-23c5-dc470028d881@orange.fr> In-Reply-To: X-Provags-ID: V03:K1:bTDRNUGejEw+3jhlrjoZsgPcsYdzsAs06zM7d1DbrtzhdbeCe8h gtr8ysHSOlqyn2gFS3Zv+icoLfxwXwc2WBb/VRixqSmbqDasj44ApidbkbW/AQNATaFFdzw MYjIczCKeRJHf3QcQbtpZs6zefZlg6dgANsoNO82shpHOKqJ6l6Iwv+4iBqlm87qpfyJiRv kSspbdQrirzpzVwSs5dPA== X-UI-Out-Filterresults: notjunk:1;V03:K0:d1tHM4uo32c=:/aH1DfP+Pjxr+RO3BfhIIG 3zaeTgTyCS/yS2dw3Iq5eDDpRxrL8wtrsC2HY39pUT9owshkBptnVTQQ2QgppxjonU5YRybFD ifEmptfWeHp6FhiB+fzJgI7OOP5ccdFiXGytJNrbutDCHQrP/aca4pGokEDwMZobQDKPmTk2y LhxUPAb28iilKmxc5I9mV5WLjBX5SBsBZVBoqhuk+Ki8h07YDGJ0205sWm8/cwn+6au5P21j+ yjzwyUUHdbdDx6OcNrHeKvWdnSnjiKQe4sBOoSRw/aRb8DEn1/ZDZOdsNa8kaidxBkO44FKhg NNVoY2ODxWK6nKfFVtZo/W/9juoimAShjQQAcwVa7mnHSg0Rwz/Kc/8DgBz74ZC1LKCrX6XD9 C8t5mS3ZkbyTVk8PZhaNp8T7dGd4KQmlhD+rGjpi3y1+pe9ITohcnaWr+mpt9nTmkshZMt1UD Hlp5LMthe11EiScRQqrA2YlXI8Mn8inAGc+HPBSMU9ni0BdL5vrCjW1pvk6wE7oV+6JdHo6HL cUzPnLeaVHq1tNlCriOMUXDvsm2lww6afagDQV9kPzsbaMTc5zODkhyHjvgJy0TEtw5tNMX5+ /l92UTevSI9X+whcwQEfEwhgUaciqvPAzfsVUCSHl+1yabvZTJfZ0DeseT1OtTnXApcO96kiz ZbeqKH2YalXB21gfhRp2msukgstNOd+u3CRR1gFpitOgHWkyAg0cIWNxMCaXi7IqdcaDPpjfy oX8A3rIIMv9ldKu/n499hiAGwVYfPU5i6I79TQlDQPAgmzjIWqQEQTBDt/xEnCAZMefX+NotN n748OHpl7lhgtt6I5VaxVASnbqWyNDf7PGlcGfmAHXKkbjP84tRAEZq6LHDrv7lJdxVikigSl ZvQcPYe1zg0e5Y54Z7iMdv/hBtKHCI8sjBz/Ogeqw4pZsldYYTnsfNjJwEog7qnpVOxVSgorc AGqYf2QC8hRDGfriSZZ6NWvT4ZQoUeaM9NNoYxoIJ3iD2bpmJuQ5CKxZUm68TLVMsCqkKLrdI lntd/zaM17v0oxG4PAzfyIOILMShbhO+4bPRDJ71jblOgz1YIw2FgB9Z0H4xEbcr1xKuisOim dvOmqU+1mmzo6+39lTfOIZKwqvCXwMBCI/FVlHIEdfF0+f7dZ4UTP4JNQ== X-Spam-Status: No, score=-11.3 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 Cc: gcc-patches@gcc.gnu.org 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?1739807873523572154?= Hi Mikael, Am 30.07.22 um 10:28 schrieb Mikael Morin: > Meh! We killed one check for gfc_current_form but the other one is still > there. > OK, match_kind_param calls two functions that also gobble space, so > there is work remaining here. > So please make match_small_literal_constant and gfc_match_name > space-gobbling wrappers around space-non-gobbling inner functions and > call those inner functions instead in match_kind_param. well, here's the shortest solution I could come up with. I added a new argument to 3 functions used in parsing that controls the gobbling of whitespace. We use this to handle whitespace for numerical literals, while the parsing of string literals remains as in the previous version of the patch. This version obviously ignores Thomas' request, as that would require to treat gfc_match_char specially... Regtested again. OK now? Thanks, Harald From cb33d1d0b91b371a864379d920ddaefc15d587f9 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 * match.cc (gfc_match_small_literal_int): Make gobbling of leading whitespace optional. (gfc_match_name): Likewise. (gfc_match_char): Likewise. * match.h (gfc_match_small_literal_int): Adjust prototype. (gfc_match_name): Likewise. (gfc_match_char): Likewise. * primary.cc (match_kind_param): Match small literal int or name without gobbling whitespace. (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/match.cc | 21 +++++++++------- gcc/fortran/match.h | 6 ++--- gcc/fortran/primary.cc | 14 +++-------- gcc/testsuite/gfortran.dg/literal_constants.f | 20 ++++++++++++++++ .../gfortran.dg/literal_constants.f90 | 24 +++++++++++++++++++ 5 files changed, 63 insertions(+), 22 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/match.cc b/gcc/fortran/match.cc index 1aa3053e70e..c0dc0e89361 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -457,7 +457,7 @@ gfc_match_eos (void) will be set to the number of digits. */ match -gfc_match_small_literal_int (int *value, int *cnt) +gfc_match_small_literal_int (int *value, int *cnt, bool gobble_ws) { locus old_loc; char c; @@ -466,7 +466,8 @@ gfc_match_small_literal_int (int *value, int *cnt) old_loc = gfc_current_locus; *value = -1; - gfc_gobble_whitespace (); + if (gobble_ws) + gfc_gobble_whitespace (); c = gfc_next_ascii_char (); if (cnt) *cnt = 0; @@ -611,14 +612,15 @@ gfc_match_label (void) than GFC_MAX_SYMBOL_LEN. */ match -gfc_match_name (char *buffer) +gfc_match_name (char *buffer, bool gobble_ws) { locus old_loc; int i; char c; old_loc = gfc_current_locus; - gfc_gobble_whitespace (); + if (gobble_ws) + gfc_gobble_whitespace (); c = gfc_next_ascii_char (); if (!(ISALPHA (c) || (c == '_' && flag_allow_leading_underscore))) @@ -1052,16 +1054,19 @@ cleanup: } -/* Tries to match the next non-whitespace character on the input. - This subroutine does not return MATCH_ERROR. */ +/* Tries to match the next non-whitespace character on the input. This + subroutine does not return MATCH_ERROR. When gobble_ws is false, do not + skip over leading blanks. +*/ match -gfc_match_char (char c) +gfc_match_char (char c, bool gobble_ws) { locus where; where = gfc_current_locus; - gfc_gobble_whitespace (); + if (gobble_ws) + gfc_gobble_whitespace (); if (gfc_next_ascii_char () == c) return MATCH_YES; diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 495c93e0b5c..1f53e0cb67d 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -45,14 +45,14 @@ extern gfc_access gfc_typebound_default_access; match gfc_match_special_char (gfc_char_t *); match gfc_match_space (void); match gfc_match_eos (void); -match gfc_match_small_literal_int (int *, int *); +match gfc_match_small_literal_int (int *, int *, bool = true); match gfc_match_st_label (gfc_st_label **); match gfc_match_small_int (int *); -match gfc_match_name (char *); +match gfc_match_name (char *, bool = true); match gfc_match_symbol (gfc_symbol **, int); match gfc_match_sym_tree (gfc_symtree **, int); match gfc_match_intrinsic_op (gfc_intrinsic_op *); -match gfc_match_char (char); +match gfc_match_char (char, bool = true); match gfc_match (const char *, ...); match gfc_match_iterator (gfc_iterator *, int); match gfc_match_parens (void); diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 3f01f67cd49..19f2e78c8ff 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -45,11 +45,11 @@ match_kind_param (int *kind, int *is_iso_c) *is_iso_c = 0; - m = gfc_match_small_literal_int (kind, NULL); + m = gfc_match_small_literal_int (kind, NULL, false); if (m != MATCH_NO) return m; - m = gfc_match_name (name); + m = gfc_match_name (name, false); if (m != MATCH_YES) return m; @@ -95,7 +95,7 @@ get_kind (int *is_iso_c) *is_iso_c = 0; - if (gfc_match_char ('_') != MATCH_YES) + if (gfc_match_char ('_', false) != MATCH_YES) return -2; m = match_kind_param (&kind, is_iso_c); @@ -1074,17 +1074,9 @@ match_string_constant (gfc_expr **result) c = gfc_next_char (); } - if (c == ' ') - { - gfc_gobble_whitespace (); - c = gfc_next_char (); - } - if (c != '_') goto no_match; - gfc_gobble_whitespace (); - c = gfc_next_char (); if (c != '\'' && c != '"') goto no_match; 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