From patchwork Mon Mar 11 21:20:27 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1910709 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=anlauf@gmx.de header.a=rsa-sha256 header.s=s31663417 header.b=aQuXB2aq; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; 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 [IPv6:2620:52:3:1:0:246e:9693:128c]) (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 4TtqSq0gYbz1yX8 for ; Tue, 12 Mar 2024 08:20:57 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id DA0BC3858289 for ; Mon, 11 Mar 2024 21:20:54 +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 1463B3858CD1; Mon, 11 Mar 2024 21:20:28 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1463B3858CD1 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 1463B3858CD1 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=1710192031; cv=none; b=c4fXIprRXo17inLNjFhgSrB7pXl3MJz2XL8d+J3IF3ltBmK1XsfTc1W+xurEYqOTJtdH1oZJxN3lay+95jDlLGEa9jaP8/ZcjMqsFq4A46mK5FD29quaIeY7h5qawgUtOEXlE5bWzqyUA1Y1Eqj+vCV26awP4ZQv4y9bWPQ/T+0= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1710192031; c=relaxed/simple; bh=qEsURJKWPjv9ff3WiY62ySDk+ncaZWVb9DbtKoi3S3c=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=RPnBQqNB4O674eBkEkCnC4cemQ21byfUPJNmHlzHb1NfOMgN6Kgkzhus3fe8znlkbYyFbkzO3o1qfFBDWtuayBjd1pwuGupAQKNuE4v9lZXUze1qMCYDNDaTkEZaHcIUSV3Omx5l0WDUad6pPDa0xM5hKAnmegN+thW2AtFtKhs= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1710192027; x=1710796827; i=anlauf@gmx.de; bh=qEsURJKWPjv9ff3WiY62ySDk+ncaZWVb9DbtKoi3S3c=; h=X-UI-Sender-Class:From:To:Subject:Date; b=aQuXB2aqiVEJiQ0pV/zSraToWd3Y4xuZ52asdWZHKxLW1lpI73v4uKJopIpfn6l5 MTcKTGixnockbirfM8YTNms/1lbGxTdjsFaySW/NYL0Saghh261OAntQ6GwgXoHMP NwL2+92z6r7VApbLRc8vRDiPdiYS2Rg6VQNHJeeP6yvAQHNKygpw7RA3H4fGYWNLa 5D92+0UDdD7AY+CJNzM8AyeAyKE8VHnf0nOwAP8DRc4YR+2wcBxUyRAKYchoTqIpw iz1Zli926l2w9Jt9p8Ka0RwL/FZADJOS+qiwk3gGxMN4bnGagzoA0Gjjet2ncWDc2 RHhDEiddjKZiqphgcw== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.7.135] ([79.251.7.135]) by web-mail.gmx.net (3c-app-gmx-bs23.server.lan [172.19.170.75]) (via HTTP); Mon, 11 Mar 2024 22:20:27 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: handle procedure pointer component in DT array [PR110826] Date: Mon, 11 Mar 2024 22:20:27 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:CKydTN89yYeB8e82IxZ/XwYsqnUUaEX6B62Wa/uxwmsaiv/Cwlmj8wYEh6soJW+7U87yt vIgOmLGsre39u/rNVh0YBlFX+38N07Opjdl1nE55knQXV3qzpQWy0vsfw5UIEh3uUCcNBbIzADez MVwEHNuyco4QK07hD5T5dyQsIO3aSIiKQFE2shc3OeoaJZXA6a/XCDtejTk/MTz8bDSoqBkpSh30 0zTdv+YsLZwNiGaumPbTUZGx2q3ePOA+dRrHgGNXPSkgWe/74jcRPVIyF4ZHqM5I20scmIYgFqlu /0= UI-OutboundReport: notjunk:1;M01:P0:kzZoDhjS1Bg=;Mj2UeFBRI1HZEYVbcm4WYSX+RIn /FG+gbk4FuZrDj2SWDg96S8M5hmFoYGUyx1jqnB5yAKf7PbM+Oitt/ZX82fWosk0ODUhIArxY 9pjFT2IcY4bKRTVAGc7DvvM04b/oL6pc1oGqV6c0tYqM3dklO2sP+8LE8ISAj57o/tCyjv0Qa 9vvt6TlN9y+TOA7z/12S2PlqyJzWGRUv6SiGn+Y5/bVXacWbBVzxZP1hfArAk0ERw1vB4nkL7 iQJNld+x9LN5zTquAmVntYsPnnqPCcnFHpQ9j+En889zb13VRvie+iSpclPVQXtOnNgbFfq4T vEtwhhkFUSQuXt1zcGW5K+t+/LUkqLozasgcwEwvtBmfTh8mIfNfDzbNZ4bVbCeXbawMRtx1i GhIUgEV230Zpm7awhNayKQcR7OBIdI9ifGOfan98QtLCRvgOTdzxxxVtmIgDRscwdxLn/Tr2J muYn4h8xOHcbMKPlnDHKj71EBW1ddGbdnwvYf2ci22TMiuCNKBIA0E0ddMbK6iJg+heeRpHth S70mvuWysflgjw0kRE0Nf8sPuCYwZAOk9DpHlJ7zkk1iLEgWlichMcTBW7iR0zat0wGASikhx /7vfdigmmcIxPyc+AyJ9rIchKxcdcD7fyEgcNi+ojZcXPin0iojWO7sFmc00l8oBJJe8HTROz YRpIMjYORe4E4ZvAAydETt++G7yE+mbTpk0B4oML9tAvJP6jfCbgbBrZYX50Q9M= X-Spam-Status: No, score=-12.4 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, T_SCC_BODY_TEXT_LINE 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 Dear all, the attached patch fixes an ICE-on-valid code when assigning a procedure pointer that is a component of a DT array and the function in question is array-valued. (The procedure pointer itself cannot be an array.) Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From a9be17cf987b796c49684cde2f20dac3839c736c Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 11 Mar 2024 22:05:51 +0100 Subject: [PATCH] Fortran: handle procedure pointer component in DT array [PR110826] gcc/fortran/ChangeLog: PR fortran/110826 * array.cc (gfc_array_dimen_size): When walking the ref chain of an array and the ultimate component is a procedure pointer, do not try to figure out its dimension even if it is a array-valued function. gcc/testsuite/ChangeLog: PR fortran/110826 * gfortran.dg/proc_ptr_comp_53.f90: New test. --- gcc/fortran/array.cc | 7 ++++ .../gfortran.dg/proc_ptr_comp_53.f90 | 41 +++++++++++++++++++ 2 files changed, 48 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90 diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc index 3a6e3a7c95b..e9934f1491b 100644 --- a/gcc/fortran/array.cc +++ b/gcc/fortran/array.cc @@ -2597,6 +2597,13 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) case EXPR_FUNCTION: for (ref = array->ref; ref; ref = ref->next) { + /* Ultimate component is a procedure pointer. */ + if (ref->type == REF_COMPONENT + && !ref->next + && ref->u.c.component->attr.function + && IS_PROC_POINTER (ref->u.c.component)) + return false; + if (ref->type != REF_ARRAY) continue; diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90 new file mode 100644 index 00000000000..881ddd3558f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90 @@ -0,0 +1,41 @@ +! { dg-do compile } +! PR fortran/110826 - procedure pointer component in DT array + +module m + implicit none + + type pp + procedure(func_template), pointer, nopass :: f =>null() + end type pp + + abstract interface + function func_template(state) result(dstate) + implicit none + real, dimension(:,:), intent(in) :: state + real, dimension(size(state,1), size(state,2)) :: dstate + end function + end interface + +contains + + function zero_state(state) result(dstate) + real, dimension(:,:), intent(in) :: state + real, dimension(size(state,1), size(state,2)) :: dstate + dstate = 0. + end function zero_state + +end module m + +program test_func_array + use m + implicit none + + real, dimension(4,6) :: state + type(pp) :: func_scalar + type(pp) :: func_array(4) + + func_scalar %f => zero_state + func_array(1)%f => zero_state + print *, func_scalar %f(state) + print *, func_array(1)%f(state) +end program test_func_array -- 2.35.3