From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: 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] Content-Type: multipart/mixed; boundary=abmob-dbae0861-476d-45df-85da-58e6d8fc68cc 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 List-Id: --abmob-dbae0861-476d-45df-85da-58e6d8fc68cc Content-Type: text/plain; charset=UTF-8 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 --abmob-dbae0861-476d-45df-85da-58e6d8fc68cc Content-Type: text/x-patch Content-Disposition: attachment; filename=pr110826.diff Content-Transfer-Encoding: quoted-printable =46rom 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. =2D-- 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 =2D-- a/gcc/fortran/array.cc +++ b/gcc/fortran/array.cc @@ -2597,6 +2597,13 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, m= pz_t *result) case EXPR_FUNCTION: for (ref =3D array->ref; ref; ref =3D ref->next) { + /* Ultimate component is a procedure pointer. */ + if (ref->type =3D=3D REF_COMPONENT + && !ref->next + && ref->u.c.component->attr.function + && IS_PROC_POINTER (ref->u.c.component)) + return false; + if (ref->type !=3D REF_ARRAY) continue; diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90 b/gcc/testsuit= e/gfortran.dg/proc_ptr_comp_53.f90 new file mode 100644 index 00000000000..881ddd3558f =2D-- /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 =3D>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 =3D 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 =3D> zero_state + func_array(1)%f =3D> zero_state + print *, func_scalar %f(state) + print *, func_array(1)%f(state) +end program test_func_array =2D- 2.35.3 --abmob-dbae0861-476d-45df-85da-58e6d8fc68cc--