From patchwork Wed Nov 9 20:50:22 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 60307 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 30860385558F for ; Wed, 9 Nov 2022 20:50:55 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 30860385558F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1668027055; bh=3uKDyiLS6rrHsPmTJs6NnYkjORLjjng7PrEKFpjcNLc=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=mUkaxJ0/Gw8m0aQQYVrszd3eGudyFc+0tUM5Lz1YIq9SnkfPWhQ0x4tLyoiizsTZF 1VoHHm3HiEATq9iyN9VIYaB9cmJw7E4KrYG+UWwmAeF0005sUPSC86qvaqPeCZAGu/ bfErhS9XXroMfDjyx+yb9IpdNkbZATQWc80AAr1Q= 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.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 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: To: fortran , gcc-patches Subject: Proxy ping [PATCH] Fortran: diagnostics for actual arguments to pointer dummy arguments [PR94104] 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 X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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 From 46957184b74af8d5a3b41704f5ef48a12f37fe33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= Date: Wed, 9 Nov 2022 21:30:25 +0100 Subject: [PATCH] Fortran: diagnostics for actual arguments to pointer dummy 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. --- 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 --- 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 != EXPR_NULL - && compare_pointer (f->sym, a->expr) == 0) + if (a->expr->expr_type != EXPR_NULL) { - if (where) - gfc_error ("Actual argument for %qs must be a pointer at %L", - f->sym->name, &a->expr->where); - ok = false; - goto match; - } + int cmp = compare_pointer (f->sym, a->expr); + bool pre2008 = ((gfc_option.allow_std & GFC_STD_F2008) == 0); - if (a->expr->expr_type != EXPR_NULL - && (gfc_option.allow_std & GFC_STD_F2008) == 0 - && compare_pointer (f->sym, a->expr) == 2) - { - if (where) - gfc_error ("Fortran 2008: Non-pointer actual argument at %L to " - "pointer dummy %qs", &a->expr->where,f->sym->name); - ok = false; - goto match; + if (pre2008 && cmp == 0) + { + if (where) + gfc_error ("Actual argument for %qs at %L must be a pointer", + f->sym->name, &a->expr->where); + ok = false; + goto match; + } + + if (pre2008 && cmp == 2) + { + if (where) + gfc_error ("Fortran 2008: Non-pointer actual argument at %L to " + "pointer dummy %qs", &a->expr->where, f->sym->name); + ok = false; + goto match; + } + + if (!pre2008 && cmp == 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 = false; + goto match; + } } diff --git a/gcc/testsuite/gfortran.dg/PR94104a.f90 b/gcc/testsuite/gfortran.dg/PR94104a.f90 new file mode 100644 index 00000000000..a1e578ac9ba --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94104a.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! +! PR fortran/94104 +! + +program diag_p + implicit none + + integer, parameter :: n = 7 + + integer :: a(n) + integer, target :: b(n) + + a = 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 argument at .1. to pointer dummy 'a'" } + +contains + + function sumf(a) result(s) + integer, pointer, intent(in) :: a(:) + + integer :: s + + s = sum(a) + end function sumf + +end program diag_p diff --git a/gcc/testsuite/gfortran.dg/PR94104b.f90 b/gcc/testsuite/gfortran.dg/PR94104b.f90 new file mode 100644 index 00000000000..ee7d640b926 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94104b.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } +! { dg-options "-std=f2008" } +! +! PR fortran/94104 +! + +program diag_p + implicit none + + integer, parameter :: n = 7 + + integer :: a(n) + integer, target :: b(n) + + a = 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 = sum(a) + end function sumf + +end program diag_p diff --git a/gcc/testsuite/gfortran.dg/parens_2.f90 b/gcc/testsuite/gfortran.dg/parens_2.f90 index bc2acd8e71d..dc5965de014 100644 --- 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 pointer or a valid target" } CONTAINS SUBROUTINE S1(I) INTEGER, POINTER ::I -- 2.35.3