From patchwork Tue Oct 1 07:43:03 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 1991343 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=gmx.de header.i=vehre@gmx.de header.a=rsa-sha256 header.s=s31663417 header.b=ZoSAnEM1; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.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 ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4XHqgX66GTz1xsc for ; Tue, 1 Oct 2024 17:43:36 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 0E531386544D for ; Tue, 1 Oct 2024 07:43:35 +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.15.19]) by sourceware.org (Postfix) with ESMTPS id 4F76438650D5; Tue, 1 Oct 2024 07:43:09 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4F76438650D5 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 4F76438650D5 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.19 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1727768592; cv=none; b=ffN/OSHOBoQVWqG5C717JzvuEiW5nsdlPh7/G4YCIyZRmnlc8+QzqdCwCVaAS95ohwJYs0qi/PxsoK13WBct70rKqNwTVxsX4cbLSUTPuxRanbysiU6lQXZjXLH7ibtSYtGkCf57LLj+Sh4Bg4E6bH8otd5JyAMHSosJaszvhhg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1727768592; c=relaxed/simple; bh=/F0RGB5VjJwzmldFHQ87k/DcDZvvs5yRgHv4oscoZr8=; h=DKIM-Signature:Date:From:To:Subject:Message-ID:MIME-Version; b=m/N2pm3Yap+ULsUDRem903t89h/XBcu5WBcnjy1TsrkDeQ16xEtxSI2rs0ESyGW3Fxf9d8Glrt2SXPoQVNecGcut72z9KUKEn11ScNSVg2DS7kYcnweOSz4iU/ZrP1G8Rs51O7wswRDaZo3Q0RPKNVHUJo/ZtgyImqbeI5FAkrs= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmx.de; s=s31663417; t=1727768588; x=1728373388; i=vehre@gmx.de; bh=iNkNO4AwjeZGlWu+DKGUODeS6RSTRD0DbmCBafqTu2s=; h=X-UI-Sender-Class:Date:From:To:Subject:Message-ID:MIME-Version: Content-Type:cc:content-transfer-encoding:content-type:date:from: message-id:mime-version:reply-to:subject:to; b=ZoSAnEM149qkraRmuA2oc/iXwBI5xx+AR3iSe0wViihXvf7XAj+e/gwZGGDo94Yz DK9a1eUx/vH25Ygnt97Y91qcT/+qTeAGiNJvMjVd4+RVdIA0ODCePUhiuMgVfklQV ugYXiFNB90lQ8zHrrDbWDCw/6S4JfIS8/AdZoB56tBw0YH83F8xfPOyGISZDVwB3r 6dSs2rKcCpchHeNu/CKOnF5ozHh14wh7QPVk1iIa4jUibh3VkqW8FadyEmXq4533V Wgl1EErG7lDqptAxTTSp/haV97VpoR2LpiJDJx2xOAKcfJU8v1nhb3tXM3odcvhsg KdZlNV7NJ2gj6SPr9A== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from vepi2 ([62.155.199.54]) by mail.gmx.net (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1N7iCW-1rquZF3wTS-00zfTJ; Tue, 01 Oct 2024 09:43:08 +0200 Date: Tue, 1 Oct 2024 09:43:03 +0200 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Subject: [Fortran, Patch, PR51815, v1] Fix parsing of substring refs in coarrays. Message-ID: <20241001094303.327b4542@vepi2> X-Mailer: Claws Mail 4.3.0 (GTK 3.24.43; x86_64-redhat-linux-gnu) MIME-Version: 1.0 X-Provags-ID: V03:K1:NajLOA3snC+seBwW0fPneco9/B4A8Po3qKzUgLnskxRfleovLTA N0K+HPCdLTiCnaLF6dfP8lg55neFDicCQoEYEIPvqZOu5gC+v4CBCJqdvDlcXUv4Kmk0CuX fydh87kBqa42/t6+N4R6i95IRM/C3Gxvd0SZh6qWpTRX+/OhQq0ZtLb+QR9UFgL12Pm/aRN Lclc3LnU+hukNnOSBEFHA== UI-OutboundReport: notjunk:1;M01:P0:8PdJhf/xf34=;tGatKaMQmV9kqa4SZxsGabenldN ri7txurrN0V7prlzLxgiHJE+dZfB62M2e3hlfcQPVmvOfLr0BoGpm/K/Z4BLEtP9lJ+6CDQnD ELMLbgjJDKCETSKU9Z7L3AofdSGYbFJchw30/AOQJKp/u/rJ8xdGmzA8Ah3/GU+XHB3i1c1co z8B90N4cPvKhaKYKrDJEj7A9ad3fQoFoomL7rp33JAoUtYqEKjM74XSaZgTGj7OYUcHDJr2Sb /nWvEASDvtS/q5b9Vyy89IZOaZ1BOvpz/J/JBX3bJJ7DMoNfgXpD7ZOsVVA57oqAfRQr6boPG CCK2swhM6Z/PvvcTT18qdop9kS1AahpkB36jn/+N0mld4SxdMSyr65mfB7kFDdDUzpEDMshpr tA6X9KIKtU0Oj7FBRv8co+MeOdBbPX20vFIsiQ7aj0Y66lcs6DTQ4eOR2r3XKE10+LG2l+/z/ H4IRK2hxgbMVsRONsafmkLeHDG/p1i/Oy3zZTFaLL9VOI949plJvbgUjhhbm8qCTi8dmEltAG KKg5j/IwuFxfE/5z4jMFdl/i+K9358MR8GzB7fcj+8/g14hRUo09fmnMWVb9W5IHxa+gF8Bf5 AX871cZDeCiGsZmkLdrHaJej869jNfVYVvNl0f16gVW18a+/TOOuxyHvsW36nRfBpBJncOQrg LF+nkareJSh5t8nnHjJrx9iCytQ0z4WEvMI8taNZv5tvobpAFO1s2L1LwQdMHo02YqwJFWHm5 PgEfPwxhAw8LSTlLcc4XlvSK7sZ3jwHrPJklWQhaCjOhDVhLUl1u9ZAtF3aLeQELgYK+4xm9/ ocYAV6P2/npy4xlt84fPajrw== X-Spam-Status: No, score=-11.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org Hi all, this rather old PR reported a parsing bug, when a coarray'ed character substring ref is to be parsed, aka CHARACTER(:) :: str[:] ... str(2:5). In this case the parser confused the substring ref with an array-ref, because an array_spec was present. This patch fixes this by requesting only coarray parsing from gfc_match_array_ref when no regular dimension is present. The patch is not involved when an array of coarray'ed strings is parsed (that worked beforehand). I had to fix the dg-error clauses in the testcase pr102532 because now the error of having to many refs is detected by the parsing stage and no longer by the resolve stage. It has become a simple syntax error. I hope this is ok. Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline? Regards, Andre --- Andre Vehreschild * Email: vehre ad gmx dot de From 1d5e0abd0e6df0ec05c3dfb4bf7cee433b885994 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Tue, 1 Oct 2024 09:30:59 +0200 Subject: [PATCH] [Fortran] Fix parsing of substring refs in coarrays. [PR51815] The parser was greadily taking the substring ref as an array ref because an array_spec was present. Fix this by only parsing the coarray (pseudo) ref when no regular array is present. gcc/fortran/ChangeLog: PR fortran/51815 * array.cc (gfc_match_array_ref): Only parse coarray part of ref. * match.h (gfc_match_array_ref): Add flag. * primary.cc (gfc_match_varspec): Request only coarray ref parsing when no regular array is present. gcc/testsuite/ChangeLog: * gfortran.dg/pr102532.f90: Fix dg-errors: Now a syntax error. * gfortran.dg/coarray/substring_1.f90: New test. --- gcc/fortran/array.cc | 9 ++++-- gcc/fortran/match.h | 3 +- gcc/fortran/primary.cc | 30 ++++++++++++------- .../gfortran.dg/coarray/substring_1.f90 | 16 ++++++++++ gcc/testsuite/gfortran.dg/pr102532.f90 | 13 ++++---- 5 files changed, 51 insertions(+), 20 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray/substring_1.f90 diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc index 1fa61ebfe2a..ed8cb54803b 100644 --- a/gcc/fortran/array.cc +++ b/gcc/fortran/array.cc @@ -179,7 +179,7 @@ matched: match gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init, - int corank) + int corank, bool coarray_only) { match m; bool matched_bracket = false; @@ -198,6 +198,8 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init, matched_bracket = true; goto coarray; } + else if (coarray_only && corank != 0) + goto coarray; if (gfc_match_char ('(') != MATCH_YES) { @@ -243,11 +245,12 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init, coarray: if (!matched_bracket && gfc_match_char ('[') != MATCH_YES) { - if (ar->dimen > 0) + int dim = coarray_only ? 0 : ar->dimen; + if (dim > 0 || coarray_only) { if (corank != 0) { - for (int i = ar->dimen; i < GFC_MAX_DIMENSIONS; ++i) + for (int i = dim; i < GFC_MAX_DIMENSIONS; ++i) ar->dimen_type[i] = DIMEN_THIS_IMAGE; ar->codimen = corank; } diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 84d84b81825..2c76afb179a 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -317,7 +317,8 @@ match gfc_match_init_expr (gfc_expr **); /* array.cc. */ match gfc_match_array_spec (gfc_array_spec **, bool, bool); -match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int); +match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int, + bool = false); match gfc_match_array_constructor (gfc_expr **); /* interface.cc. */ diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 09add925fcd..d73d5eaed84 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2192,7 +2192,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, bool intrinsic; bool inferred_type; locus old_loc; - char sep; + char peeked_char; tail = NULL; @@ -2282,9 +2282,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, sym->ts.u.derived = tgt_expr->ts.u.derived; } - if ((inferred_type && !sym->as && gfc_peek_ascii_char () == '(') - || (equiv_flag && gfc_peek_ascii_char () == '(') - || gfc_peek_ascii_char () == '[' || sym->attr.codimension + peeked_char = gfc_peek_ascii_char (); + if ((inferred_type && !sym->as && peeked_char == '(') + || (equiv_flag && peeked_char == '(') || peeked_char == '[' + || sym->attr.codimension || (sym->attr.dimension && sym->ts.type != BT_CLASS && !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary) && !(gfc_matching_procptr_assignment @@ -2295,6 +2296,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, || CLASS_DATA (sym)->attr.codimension))) { gfc_array_spec *as; + bool coarray_only = sym->attr.codimension && !sym->attr.dimension + && sym->ts.type == BT_CHARACTER; tail = extend_ref (primary, tail); tail->type = REF_ARRAY; @@ -2310,12 +2313,18 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, else as = sym->as; - m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, - as ? as->corank : 0); + m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, as ? as->corank : 0, + coarray_only); if (m != MATCH_YES) return m; gfc_gobble_whitespace (); + if (coarray_only) + { + primary->ts = sym->ts; + goto check_substring; + } + if (equiv_flag && gfc_peek_ascii_char () == '(') { tail = extend_ref (primary, tail); @@ -2333,14 +2342,13 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, return MATCH_YES; /* With DEC extensions, member separator may be '.' or '%'. */ - sep = gfc_peek_ascii_char (); + peeked_char = gfc_peek_ascii_char (); m = gfc_match_member_sep (sym); if (m == MATCH_ERROR) return MATCH_ERROR; inquiry = false; - if (m == MATCH_YES && sep == '%' - && primary->ts.type != BT_CLASS + if (m == MATCH_YES && peeked_char == '%' && primary->ts.type != BT_CLASS && (primary->ts.type != BT_DERIVED || inferred_type)) { match mm; @@ -2453,7 +2461,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, && m == MATCH_YES && !inquiry) { gfc_error ("Unexpected %<%c%> for nonderived-type variable %qs at %C", - sep, sym->name); + peeked_char, sym->name); return MATCH_ERROR; } @@ -2484,7 +2492,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (inquiry) sym = NULL; - if (sep == '%') + if (peeked_char == '%') { if (tmp) { diff --git a/gcc/testsuite/gfortran.dg/coarray/substring_1.f90 b/gcc/testsuite/gfortran.dg/coarray/substring_1.f90 new file mode 100644 index 00000000000..3c3ddc7fac4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/substring_1.f90 @@ -0,0 +1,16 @@ +!{ dg-do run } + +! Test PR51815 is fixed +! Contributed by Bill Long + +PROGRAM pr51815 + implicit none + character(10) :: s[*] + character(18) :: d = 'ABCDEFGHIJKLMNOPQR' + integer :: img + + img = this_image() + s = d(img:img+9) + if (img == 1 .and. s(2:4) /= 'BCD') stop 1 +END PROGRAM + diff --git a/gcc/testsuite/gfortran.dg/pr102532.f90 b/gcc/testsuite/gfortran.dg/pr102532.f90 index 714379a6ac2..999ca88482f 100644 --- a/gcc/testsuite/gfortran.dg/pr102532.f90 +++ b/gcc/testsuite/gfortran.dg/pr102532.f90 @@ -5,12 +5,15 @@ ! subroutine foo character(:), allocatable :: x[:] - associate (y => x(:)(2:)) ! { dg-error "Rank mismatch|deferred type parameter" } - end associate + character(:), dimension(:), allocatable :: c[:] + associate (y => x(:)(2:)) ! { dg-error "Expected '\\)' or ','" } + end associate ! { dg-error "Expecting END SUBROUTINE" } + associate (a => c(:)(:)(2:)) ! { dg-error "Expected '\\)' or ','" } + end associate ! { dg-error "Expecting END SUBROUTINE" } end subroutine bar character(:), allocatable :: x[:] - associate (y => x(:)(:)) ! { dg-error "Rank mismatch|deferred type parameter" } - end associate -end \ No newline at end of file + associate (y => x(:)(:)) ! { dg-error "Expected '\\)' or ','" } + end associate ! { dg-error "Expecting END SUBROUTINE" } +end -- 2.46.2