From patchwork Fri Feb 23 21:15:17 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 86313 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 780563858294 for ; Fri, 23 Feb 2024 21:16:05 +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.15]) by sourceware.org (Postfix) with ESMTPS id F31B13858413; Fri, 23 Feb 2024 21:15:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org F31B13858413 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 F31B13858413 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.15 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1708722922; cv=none; b=pe4J0t5pJt58EC8OuFV8qB9b29ksvSv3gEzU5u07R+HfdW84Qtmkf62HTObZQb5y2BRGyejQkxaT0ycrV41qipfSS32vaPeCrTW6AOPJMYQTt+OmUl9nTHIeyuXYU+aAD3JjjGu1/piTX0triXBMNAje9MlvW5Q076FF7O9rME8= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1708722922; c=relaxed/simple; bh=cPO/ZjID/O9/OUXydlb46S1c5x6c+iQ/9gwqiACBPpE=; h=DKIM-Signature:Message-ID:Date:MIME-Version:Subject:From:To; b=XWaX8gG1nCry4sdJg44ofKN5fGl660yh9VL4p9Tp15mKxvUuNedesV5ajR7lOmvuVjx/zejz1SZC2L+eEhxotcsgKobntp1TQlo6pNP72QFoAx+8fe1ynQoFgKH25+vbe9Xa1KSZNFqVUB1r2xkWYSwXaHGQC0em9k3uM2q7MVM= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1708722918; x=1709327718; i=anlauf@gmx.de; bh=cPO/ZjID/O9/OUXydlb46S1c5x6c+iQ/9gwqiACBPpE=; h=X-UI-Sender-Class:Date:Subject:From:To:Cc:References: In-Reply-To; b=ndHcJbZSna8i3ECFjd3CdufZHsdfMyXQqDs7+SPXlmcQAf3Kj8MtKEAH/BwttARs CjWm4ceYrQJCqV/9CuCdDLnp5ohQsVKiQXYzfv7ardtYLgjXBjlgZt3A6JnOLPc3N KrwasFzO4+e/5dSdlT3shqtiR0r7b71iIJKnwvAyg16OXbtWg7Wyxv9oZ3m27CFn+ GCvq1w/jLfPB34Elz9hSfpZxVAlIivBLppabhxVybG3g/lf1fyxdyj+4J6oYae6JK Hzc45Xl5j/6L6jLPs5+/kNt7w8E2nLcF6EgsDjebCRFXuXH2lc/IVIvbkhEZobv4q 5Fn+918V93Lex+0H8A== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [192.168.178.29] ([93.207.92.3]) by mail.gmx.net (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MtfJd-1qmCkr2agZ-00v9nd; Fri, 23 Feb 2024 22:15:18 +0100 Message-ID: <204319dc-e3ce-47f3-9a95-676f03649aad@gmx.de> Date: Fri, 23 Feb 2024 22:15:17 +0100 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Subject: [PATCH, v2] Fix fortran/PR114024 From: Harald Anlauf To: gcc-patches@gcc.gnu.org Cc: fortran@gcc.gnu.org Newsgroups: gmane.comp.gcc.patches,gmane.comp.gcc.fortran References: <29ba08a7-8218-4591-8c3f-36c17090e497@gmail.com> <3444d912-2e79-4e16-a425-79810d161ebb@gmx.de> <406c0c3a-f9a4-4f40-a44d-2db284060a59@gmx.de> <36c5afe2-07d5-41b2-8410-721f2a54dd51@gmx.de> Content-Language: en-US In-Reply-To: <36c5afe2-07d5-41b2-8410-721f2a54dd51@gmx.de> X-Provags-ID: V03:K1:/piHHhqtk/NJyGG2VHmI94GcO5F4I0XCwtZMvdp4wLNbWSM+8UP Eg8Z3wMPV42WEzC01Ib4Sz6jrj7TkOGfcKH84lUU3ZoOYwCpChSQwvhUoU1u5yx5y98ZOMS sYs1bMsTQDBC8C4eHAlGoXiIDh6qNiEViouP3LV6RrQjwAubVWJKe6EEuIrRRAY70UtlbbJ k9G8c2vuFj2Ou19GErklQ== UI-OutboundReport: notjunk:1;M01:P0:hOewkxj2UMo=;tkQtew29NmTJI+syLFQhWfDuNUy zIqm6JbzRGqZbvzHGwkR2xhKvRXGbUjYoEUMhsoZLcg4/DKldcuKK00EhkVG86QrVFfUmMcqd eQEQaZ1GshCG4vDuKodXuH1QlNmRfpXiCwMohRF1E+pdDneQg4lv7DtY8HvnolTBlXFAgQEab THW8tCmPbClrure9X6Vlb3m2CEuYelwr2EpFVNOH37mOqmKyxfD/oaBx85cROymP1ibgT9BGo k4rbgkbzQX/NbYMLfTeElGhMqrtBXnIfJ1wd+OUsaUENxvjpCS8yPN9j1pWUFkvwN1BYkaTAQ BTX31XuXa8HDZzUHIJ4S7xt4ACW7GErplRpvXvHX0v850h3aM116gO8iYD/SiIvx26h6eTjIy swiwGCRLjKYqPJWcqvxlyYBTerIXO8zPSVPoeIKTylOkvw2EKnh/u2px2aSL4blp6j8W+68GJ R8/da0a2H1R0Qhxmoef9pYAdsOmONEe+D9GY4YHX7y43c3sdak9eDp6H+g82pZ9U/84SFdlS3 3Hv3aZDrzKoSr0W45Nx8esNvilM7tyvTEg3AOKYw2oSGpm86aXtNun3lK3YeXqEO030PIlHq2 awYuApIyxoPutvwjit2GA8xXKCMe7aZnQelxHjMh7957nS9ErwoN0tQHEvr+skNphYZi6ZgWG f42ZrNc1fNjdbLXumEkb3Yfm0Mt/YjRkK+DHNWVWv+iQbmNeLAh88XWIeFEHFg8cHU3rfKW/M xVNyHojiTRkkCVwSt9amNIeVfXM7KLborYl2Se2lCWPnLn4Gg1o2eluQWx1Rj699y1TL1M9KY /u9BqFgi5IGi+F/u5a3ji2nqHshyNbSgeTjJKJdvlzB6U= X-Spam-Status: No, score=-10.5 required=5.0 tests=BAYES_00, BODY_8BITS, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE, WEIRD_PORT 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+patchwork=sourceware.org@gcc.gnu.org Hi Steve, all, here's an updated patch with an enhanced testcase that also checks MOLD= besides SOURCE=. Regtested on x86_64-pc-linux-gnu. Is it OK for mainline? Cheers, Harald On 2/22/24 22:32, Harald Anlauf wrote: > On 2/22/24 22:01, Steve Kargl wrote: >> BTW, my patch and I suspect your improved patch also >> fixes 'allocate(x,mold=z%re)'.  Consider, >> >>     complex z(3) >>     real, allocatable :: x(:) >>     z = 42ha >>     allocate(x, mold=z%re) >>     print *, size(x) >>     end >> >> % gfortran13 -o z a.f90 >> a.f90:9:25: >> >>      9 |    allocate(x, mold=z%re) >>        |                         1 >> internal compiler error: in retrieve_last_ref, at >> fortran/trans-array.cc:6070 >> 0x247d7a679 __libc_start1 >>          /usr/src/lib/libc/csu/libc_start1.c:157 >> >> % gfcx -o z a.f90 && ./z >>             3 >> > > Nice!  I completely forgot about MOLD... > > So the only missing pieces are a really comprehensive testcase > and successful regtests... From a176c2f44f812d82aeb430fadf23ab4b6dd5bd65 Mon Sep 17 00:00:00 2001 From: Steve Kargl Date: Fri, 23 Feb 2024 22:05:04 +0100 Subject: [PATCH] Fortran: ALLOCATE statement, SOURCE/MOLD expressions with subrefs [PR114024] PR fortran/114024 gcc/fortran/ChangeLog: * trans-stmt.cc (gfc_trans_allocate): When a source expression has substring references, part-refs, or %re/%im inquiries, wrap the entity in parentheses to force evaluation of the expression. gcc/testsuite/ChangeLog: * gfortran.dg/allocate_with_source_27.f90: New test. * gfortran.dg/allocate_with_source_28.f90: New test. Co-Authored-By: Harald Anlauf --- gcc/fortran/trans-stmt.cc | 10 ++- .../gfortran.dg/allocate_with_source_27.f90 | 20 +++++ .../gfortran.dg/allocate_with_source_28.f90 | 90 +++++++++++++++++++ 3 files changed, 118 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_27.f90 create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_28.f90 diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 5247d3d39d7..e09828e218b 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -6355,8 +6355,14 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate) vtab_needed = (al->expr->ts.type == BT_CLASS); gfc_init_se (&se, NULL); - /* When expr3 is a variable, i.e., a very simple expression, - then convert it once here. */ + /* When expr3 is a variable, i.e., a very simple expression, then + convert it once here. If one has a source expression that has + substring references, part-refs, or %re/%im inquiries, wrap the + entity in parentheses to force evaluation of the expression. */ + if (code->expr3->expr_type == EXPR_VARIABLE + && is_subref_array (code->expr3)) + code->expr3 = gfc_get_parentheses (code->expr3); + if (code->expr3->expr_type == EXPR_VARIABLE || code->expr3->expr_type == EXPR_ARRAY || code->expr3->expr_type == EXPR_CONSTANT) diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90 new file mode 100644 index 00000000000..d0f0f3c4a84 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90 @@ -0,0 +1,20 @@ +! +! { dg-do run } +! +! fortran/PR114024 +! https://github.com/fujitsu/compiler-test-suite +! Modified from Fortran/0093/0093_0130.f90 +! +program foo + implicit none + complex :: cmp(3) + real, allocatable :: xx(:), yy(:), zz(:) + cmp = (3., 6.78) + allocate(xx, source = cmp%re) ! This caused an ICE. + allocate(yy, source = cmp(1:3)%re) ! This caused an ICE. + allocate(zz, source = (cmp%re)) + if (any(xx /= [3., 3., 3.])) stop 1 + if (any(yy /= [3., 3., 3.])) stop 2 + if (any(zz /= [3., 3., 3.])) stop 3 +end program foo + diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90 new file mode 100644 index 00000000000..976c567cf22 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90 @@ -0,0 +1,90 @@ +! { dg-do run } +! +! PR fortran/114024 + +program foo + implicit none + complex :: cmp(3) = (3.,4.) + type ci ! pseudo "complex integer" type + integer :: re + integer :: im + end type ci + type cr ! pseudo "complex" type + real :: re + real :: im + end type cr + type u + type(ci) :: ii(3) + type(cr) :: rr(3) + end type u + type(u) :: cc + + cc% ii% re = nint (cmp% re) + cc% ii% im = nint (cmp% im) + cc% rr% re = cmp% re + cc% rr% im = cmp% im + + call test_substring () + call test_int_real () + call test_poly () + +contains + + subroutine test_substring () + character(4) :: str(3) = ["abcd","efgh","ijkl"] + character(:), allocatable :: ac(:) + allocate (ac, source=str(1::2)(2:4)) + if (size (ac) /= 2 .or. len (ac) /= 3) stop 11 + if (ac(2) /= "jkl") stop 12 + deallocate (ac) + allocate (ac, mold=str(1::2)(2:4)) + if (size (ac) /= 2 .or. len (ac) /= 3) stop 13 + deallocate (ac) + end + + subroutine test_int_real () + integer, allocatable :: aa(:) + real, pointer :: pp(:) + allocate (aa, source = cc% ii% im) + if (size (aa) /= 3) stop 21 + if (any (aa /= cmp% im)) stop 22 + allocate (pp, source = cc% rr% re) + if (size (pp) /= 3) stop 23 + if (any (pp /= cmp% re)) stop 24 + deallocate (aa, pp) + end + + subroutine test_poly () + class(*), allocatable :: uu(:), vv(:) + allocate (uu, source = cc% ii% im) + allocate (vv, source = cc% rr% re) + if (size (uu) /= 3) stop 31 + if (size (vv) /= 3) stop 32 + call check (uu) + call check (vv) + deallocate (uu, vv) + allocate (uu, mold = cc% ii% im) + allocate (vv, mold = cc% rr% re) + if (size (uu) /= 3) stop 33 + if (size (vv) /= 3) stop 34 + deallocate (uu, vv) + end + + subroutine check (x) + class(*), intent(in) :: x(:) + select type (x) + type is (integer) + if (any (x /= cmp% im)) then + print *, "'integer':", x + stop 41 + end if + type is (real) + if (any (x /= cmp% re)) then + print *, "'real':", x + stop 42 + end if + type is (character(*)) + print *, "'character':", x + end select + end +end -- 2.35.3