From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.20]) by sourceware.org (Postfix) with ESMTPS id ADC3B3858D1E; Wed, 9 Nov 2022 20:50:24 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org ADC3B3858D1E Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1668027023; bh=wppv+mqh3jVZHPcemjd3ckgJWT5KUD4s0bn6KEGW6Lw=; h=X-UI-Sender-Class:From:To:Subject:Date; b=EMsa5d4iVD60ycrVTHAQmz/DdATmyxCyLlxzBm+ac/OQd+OqdCfswBugeEx0dfi0E ixWWGM+q/bWBNcCWTHazw+YRZPSxheHrlSPY+cGKRMO0vMMMdWmE9MxPnqjxhej3tL yEi/g7XRuuNBaA6LsTdjctaMVbqHYXIkv7LFGB+EzLF6/zvF5lDUEW7rQTS0xCWPI9 G+mGaDbyqOx4YY272DqLxU2WX3LlFWmJjqiMqDtZjfqMnr2ndxa7uCFevYqNXGxa7X T65NfH70zxqPlyORNi0v40VionT7Xuuz/Z7IzPXUcbqPO8HpwcqKPEoV9tWk9ms7Lk y7a6w5y+hGovw== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [93.207.86.171] ([93.207.86.171]) by web-mail.gmx.net (3c-app-gmx-bap34.server.lan [172.19.172.104]) (via HTTP); Wed, 9 Nov 2022 21:50:22 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: Proxy ping [PATCH] Fortran: diagnostics for actual arguments to pointer dummy arguments [PR94104] Content-Type: multipart/mixed; boundary=rehcsed-d74259b5-b7f6-4a85-b936-aeffb734d8f8 Date: Wed, 9 Nov 2022 21:50:22 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:mzMg4A1PbWq8YgB1bwmundJzQclSvvS05AUSM+YDYGJgLMeWywpHnr23CebxdWJjIZ9DY OfPzcupVqIqaHSurv68bGaPNrzM4qh4TRswH4aubdKCg/o31xehzn74AwXrjzyLbI+sTs6V7CsFI +dWM7ILgnjOM0X+6ufmAHeki1JcvjxPPJLeV5LPm4JI8qqDkfOgC5gvzqwQM98iaweKG5m1Rho7+ MuCKv3YW/mMOWxNbonGU1GjpdREJ5gtvmUVCveoA2YIHRs6xKsSI6rg66XoE6qyC+BWNuoxp5Qcr i4= UI-OutboundReport: notjunk:1;M01:P0:CSiCcCRMzP8=;GUBj7tfm8CyG8VzCwO9W8RngByN dn/lJYAEpQ0kebp0x5hiezjqVdBpS53nNcJ35qMd90v3nmnS1Ta4xa6zNC+gK7RFTEyA8UT+r BnFEHe8ruQbo49bIpsKjhrGOcWaCBxUC02RfnenjhYJfsJX411O76QxUt+MLBRUKCyymcTJsE WpmK9JVjkGp4JOTIdBbWXOL1DbxEhiBAtneNSm6q5kScJsBbuF6SjvfELs2BiO7AvsfSr4dZy XPniUrpkZXxzsAbtlnVywgFS8UIVtaUwpezeYRdREDmhxf7Sj1+XXkU9ciXxcv8bKH0INZ1XI DhXSR9kzUQKtIDZ2tjsfWoKPiTfhb8DFGy+vpaolT0xn0oyaKnY+X0EByo2Vzqafo824Xj/je r7TVfDyX1SUMdULy+LaXBxVWEhKjcNhr6CIqxm7/nQ5k9gBiBPXa6VY+HVS0e86UIuLB9xSka NWOeLPzdLTvj9nF+iajx2k22uZMyQYEDqgGp3F4uGD7wBqCT1A0xX0JzpnKgPRCFWrcdIz8od 9KXl6hEv4IQpqnZXPIGgPP3LHsQkK0eYojQ3eANdpOI3MjV7gm3m9KZ0koY9HuwfRX563G+cF FTOdUEUCymX84C5mxIJen44tEwqx6HBOTqVKlIvtjukA5BZSpTJ+G6qY3UKICj5TMNCb3Bir4 SnKX5GeC4tj9dEeRa28hGYcdPeQbDz2ny+YeTGKLtBjQ1ykoXUSUVzfRXprabN+v9mrlIl7i5 BT1e8tfvvZRlQ/s8/oC3TdogSzZgHNyYWKUU58KW2CeddwamvmxR2KPML288sXAKKAZwWiHjj zljq46mZBQM3sM0mRyUL53JxFrTLulfnqAuKpNRgJc+xk= X-Spam-Status: No, score=-13.3 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,KAM_SHORT,RCVD_IN_DNSWL_LOW,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 List-Id: --rehcsed-d74259b5-b7f6-4a85-b936-aeffb734d8f8 Content-Type: text/plain; charset=UTF-8 Dear all, Jose posted a patch here that was never reviewed: https://gcc.gnu.org/pipermail/fortran/2021-June/056162.html I think the diagnostics improvement is helpful, as it adjusts to the changes from F2003 to F2008. The patch suffered a little from bitrot, but was otherwise straightforward to apply. I slightly edited the commit message, as I found the original one difficult to parse. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald --rehcsed-d74259b5-b7f6-4a85-b936-aeffb734d8f8 Content-Type: text/x-patch Content-Disposition: attachment; filename=pr94104.diff Content-Transfer-Encoding: quoted-printable =46rom 46957184b74af8d5a3b41704f5ef48a12f37fe33 Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Jos=3DC3=3DA9=3D20Rui=3D20Faustino=3D20de=3D20Sousa?=3D Date: Wed, 9 Nov 2022 21:30:25 +0100 Subject: [PATCH] Fortran: diagnostics for actual arguments to pointer dumm= y arguments [PR94104] Error message improvement. In Fortran 2008 actual procedure arguments associated with a pointer, intent(in) attribute, dummy argument can also have the target attribute, not just pointer. gcc/fortran/ChangeLog: PR fortran/94104 * interface.cc (gfc_compare_actual_formal): Improve error message dependent on Fortran standard level. gcc/testsuite/ChangeLog: PR fortran/94104 * gfortran.dg/parens_2.f90: Adjust to improved error message. * gfortran.dg/PR94104a.f90: New test. * gfortran.dg/PR94104b.f90: New test. =2D-- gcc/fortran/interface.cc | 48 +++++++++++++++++--------- gcc/testsuite/gfortran.dg/PR94104a.f90 | 29 ++++++++++++++++ gcc/testsuite/gfortran.dg/PR94104b.f90 | 29 ++++++++++++++++ gcc/testsuite/gfortran.dg/parens_2.f90 | 2 +- 4 files changed, 90 insertions(+), 18 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/PR94104a.f90 create mode 100644 gcc/testsuite/gfortran.dg/PR94104b.f90 diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index d3e199535b3..49dbd1d886c 100644 =2D-- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -3477,25 +3477,39 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap= , gfc_formal_arglist *formal, goto match; } - if (a->expr->expr_type !=3D EXPR_NULL - && compare_pointer (f->sym, a->expr) =3D=3D 0) + if (a->expr->expr_type !=3D EXPR_NULL) { - if (where) - gfc_error ("Actual argument for %qs must be a pointer at %L", - f->sym->name, &a->expr->where); - ok =3D false; - goto match; - } + int cmp =3D compare_pointer (f->sym, a->expr); + bool pre2008 =3D ((gfc_option.allow_std & GFC_STD_F2008) =3D=3D 0); - if (a->expr->expr_type !=3D EXPR_NULL - && (gfc_option.allow_std & GFC_STD_F2008) =3D=3D 0 - && compare_pointer (f->sym, a->expr) =3D=3D 2) - { - if (where) - gfc_error ("Fortran 2008: Non-pointer actual argument at %L to " - "pointer dummy %qs", &a->expr->where,f->sym->name); - ok =3D false; - goto match; + if (pre2008 && cmp =3D=3D 0) + { + if (where) + gfc_error ("Actual argument for %qs at %L must be a pointer", + f->sym->name, &a->expr->where); + ok =3D false; + goto match; + } + + if (pre2008 && cmp =3D=3D 2) + { + if (where) + gfc_error ("Fortran 2008: Non-pointer actual argument at %L to " + "pointer dummy %qs", &a->expr->where, f->sym->name); + ok =3D false; + goto match; + } + + if (!pre2008 && cmp =3D=3D 0) + { + if (where) + gfc_error ("Actual argument for %qs at %L must be a pointer " + "or a valid target for the dummy pointer in a " + "pointer assignment statement", + f->sym->name, &a->expr->where); + ok =3D false; + goto match; + } } diff --git a/gcc/testsuite/gfortran.dg/PR94104a.f90 b/gcc/testsuite/gfortr= an.dg/PR94104a.f90 new file mode 100644 index 00000000000..a1e578ac9ba =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94104a.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } +! { dg-options "-std=3Df2003" } +! +! PR fortran/94104 +! + +program diag_p + implicit none + + integer, parameter :: n =3D 7 + + integer :: a(n) + integer, target :: b(n) + + a =3D 1 + print *, sumf(a) ! { dg-error "Actual argument for 'a' at .1. must be a= pointer" } + print *, sumf(b) ! { dg-error "Fortran 2008: Non-pointer actual argumen= t at .1. to pointer dummy 'a'" } + +contains + + function sumf(a) result(s) + integer, pointer, intent(in) :: a(:) + + integer :: s + + s =3D sum(a) + end function sumf + +end program diag_p diff --git a/gcc/testsuite/gfortran.dg/PR94104b.f90 b/gcc/testsuite/gfortr= an.dg/PR94104b.f90 new file mode 100644 index 00000000000..ee7d640b926 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94104b.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } +! { dg-options "-std=3Df2008" } +! +! PR fortran/94104 +! + +program diag_p + implicit none + + integer, parameter :: n =3D 7 + + integer :: a(n) + integer, target :: b(n) + + a =3D 1 + print *, sumf(a) ! { dg-error "Actual argument for 'a' at .1. must be a= pointer or a valid target" } + print *, sumf(b) + +contains + + function sumf(a) result(s) + integer, pointer, intent(in) :: a(:) + + integer :: s + + s =3D sum(a) + end function sumf + +end program diag_p diff --git a/gcc/testsuite/gfortran.dg/parens_2.f90 b/gcc/testsuite/gfortr= an.dg/parens_2.f90 index bc2acd8e71d..dc5965de014 100644 =2D-- a/gcc/testsuite/gfortran.dg/parens_2.f90 +++ b/gcc/testsuite/gfortran.dg/parens_2.f90 @@ -2,7 +2,7 @@ ! { dg-do compile } ! Originally contributed by Joost VandeVondele INTEGER, POINTER :: I -CALL S1((I)) ! { dg-error "Actual argument for .i. must be a pointer" } +CALL S1((I)) ! { dg-error "Actual argument for .i. at .1. must be a point= er or a valid target" } CONTAINS SUBROUTINE S1(I) INTEGER, POINTER ::I =2D- 2.35.3 --rehcsed-d74259b5-b7f6-4a85-b936-aeffb734d8f8--