From patchwork Thu Sep 23 15:50:24 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 45366 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 7385C3857831 for ; Thu, 23 Sep 2021 15:51:27 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id B68523857C5B; Thu, 23 Sep 2021 15:50:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org B68523857C5B Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: BNyjXyi+4PJs+bVtWI8qnuvFYcO+ugvX2VZLXq3l91QUf3lXb7MOk9y8EDhyb9LiSWrnShL/2m osJFJU9fGHUCBvJENaz/ljz9yarhgKpM6onD1EJvwZjJyoel/GguM7jeF2hPNzMuXwy2porHPm gza+q0LVP6Ettp+/VH8f+v3QvbmaCoGza91t4aEjm8nh9ic8F7yI9mRS0mc1e/jqnwxbgAy7b3 UxRkNZMSDLJ9JJJg0+PMniayvDRKFN3OswFJnO3awPOqMlVAoFqVnPEuQeUII5v6SenrqR6NfW m7aFKrRpaC5e0oGW7Uhr3EJG X-IronPort-AV: E=Sophos;i="5.85,316,1624348800"; d="scan'208";a="66216388" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 23 Sep 2021 07:50:57 -0800 IronPort-SDR: eDsPOqcu34bqh9D+38G5stcq9U5OggH5aGvMU99+qq/Ix5zo4nKAsfL/fmVMDFzStHtqe85MuC KhKM97OBnKRxLKBcfC8IZ/0ZkE7o7Jvw7BE5JZiu545+Ncj7TSwe4RsTepouLMeg0bBPbAhNd3 68blfsTTuCAWaajKDma4qFbJLprlH71mTYAHVJl3aCABRQYTcW2BEBol/1IptyxGaWNbSIGO+Q mgz6wWXOr556RguzXuRZS/SvH3pQBwjE7QpDiKBXMCyTYsfMfY9usRo/hpkFuVyUj4ZY6Xo+A8 Ejk= To: "fortran@gcc.gnu.org" , "gcc-patches@gcc.gnu.org" From: Sandra Loosemore Subject: [PATCH, Fortran] Diagnose default-initialized pointer/allocatable dummies Message-ID: <5341774b-4222-d2a1-ef09-6343c672c11c@codesourcery.com> Date: Thu, 23 Sep 2021 09:50:24 -0600 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.13.0 MIME-Version: 1.0 Content-Language: en-US X-ClientProxiedBy: svr-orw-mbx-04.mgc.mentorg.com (147.34.90.204) To svr-orw-mbx-03.mgc.mentorg.com (147.34.90.203) X-Spam-Status: No, score=-9.8 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch is for PR101320, another issue related to missing bind(c) diagnostics. OK to commit? -Sandra commit d3507154fd34e65e2887262218fec09d5fb082a2 Author: Sandra Loosemore Date: Thu Sep 23 08:03:52 2021 -0700 Fortran: Diagnose default-initialized pointer/allocatable dummies TS29113 changed what was then C516 in the 2010 Fortran standard (now C1557 in F2018) from disallowing all of pointer, allocatable, and optional attributes on dummy arguments to BIND(C) functions, to disallowing only pointer/allocatable with default-initialization. gfortran was previously failing to diagnose violations of this constraint. 2021-09-23 Sandra Loosemore PR Fortran/101320 gcc/fortran/ * decl.c (gfc_verify_c_interop_param): Handle F2018 C1557, aka TS29113 C516. gcc/testsuite/ * gfortran.dg/c-interop/c516.f90: Remove xfails. Add more tests. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f2e8896..b3c65b7 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1557,6 +1557,20 @@ gfc_verify_c_interop_param (gfc_symbol *sym) "CONTIGUOUS attribute as procedure %qs is BIND(C)", sym->name, &sym->declared_at, sym->ns->proc_name->name); + /* Per F2018, C1557, pointer/allocatable dummies to a bind(c) + procedure that are default-initialized are not permitted. */ + if ((sym->attr.pointer || sym->attr.allocatable) + && sym->ts.type == BT_DERIVED + && gfc_has_default_initializer (sym->ts.u.derived)) + { + gfc_error ("Default-initialized %s dummy argument %qs " + "at %L is not permitted in BIND(C) procedure %qs", + (sym->attr.pointer ? "pointer" : "allocatable"), + sym->name, &sym->declared_at, + sym->ns->proc_name->name); + retval = false; + } + /* Character strings are only C interoperable if they have a length of 1. However, as an argument they are also iteroperable when passed as descriptor (which requires len=: or len=*). */ diff --git a/gcc/testsuite/gfortran.dg/c-interop/c516.f90 b/gcc/testsuite/gfortran.dg/c-interop/c516.f90 index 208eb84..d6a65af 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/c516.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/c516.f90 @@ -27,6 +27,10 @@ module m2 interface + ! First test versions with optional attributes on the argument. + ! TS29113 removed the constraint disallowing optional arguments + ! that previously used to be in C516. + ! good, no default initialization, no pointer/allocatable attribute subroutine s1a (x) bind (c) use m1 @@ -52,16 +56,54 @@ module m2 end subroutine ! bad, default initialization + allocatable - subroutine s2b (x) bind (c) ! { dg-error "BIND\\(C\\)" "pr101320" { xfail *-*-* } } + subroutine s2b (x) bind (c) ! { dg-error "BIND\\(C\\)" } use m1 type(t2), allocatable, optional :: x end subroutine ! bad, default initialization + pointer - subroutine s2c (x) bind (c) ! { dg-error "BIND\\(C\\)" "pr101320" { xfail *-*-* } } + subroutine s2c (x) bind (c) ! { dg-error "BIND\\(C\\)" } use m1 type(t2), pointer, optional :: x end subroutine + ! Now do all the same tests without the optional attribute. + + ! good, no default initialization, no pointer/allocatable attribute + subroutine s3a (x) bind (c) + use m1 + type(t1) :: x + end subroutine + + ! good, no default initialization + subroutine s3b (x) bind (c) + use m1 + type(t1), allocatable :: x + end subroutine + + ! good, no default initialization + subroutine s3c (x) bind (c) + use m1 + type(t1), pointer :: x + end subroutine + + ! good, default initialization but no pointer/allocatable attribute + subroutine s4a (x) bind (c) + use m1 + type(t2) :: x + end subroutine + + ! bad, default initialization + allocatable + subroutine s4b (x) bind (c) ! { dg-error "BIND\\(C\\)" } + use m1 + type(t2), allocatable :: x + end subroutine + + ! bad, default initialization + pointer + subroutine s4c (x) bind (c) ! { dg-error "BIND\\(C\\)" } + use m1 + type(t2), pointer :: x + end subroutine + end interface end module