From patchwork Tue Apr 30 14:53:42 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 240634 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 5A5F92C00CC for ; Wed, 1 May 2013 00:53:57 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=FYxF/qRHqI3RBiYJocy1CaAEZb8kwZ+EPqENyNk4ZSEEua 4mr4kF75os0W2CwTTR2tGQdnspikqeF5c29+vCU0kect74PUqVh24qohncrsodXZ sgWfi8N7k7AS29Ju7yr2bMiF9iwQkpbN6ddlsvwmww+mKWrH11IUwxVmlOwKY= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=3jVN2g5jxQgh4+fI6ijzlE0FsAw=; b=elR6D0C+KI9sP48e+lnh 6I+kmSpZwjs9aRBupB0xP0Jatjx7KAJgbwTr1LUuC4HBgz0WP32H3eWuqxJgMLsT dGj/0cxvXn9/FyvOchay/rmWwv2UgLgp0Im3oxiO2/11kw7h0VdSx7KX6IgItBM4 yU0nB0qGFHr40G4L1ueO0h8= Received: (qmail 11994 invoked by alias); 30 Apr 2013 14:53:49 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 11979 invoked by uid 89); 30 Apr 2013 14:53:49 -0000 X-Spam-SWARE-Status: No, score=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RCVD_IN_SEMBACKSCATTER autolearn=no version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Tue, 30 Apr 2013 14:53:47 +0000 Received: from archimedes.net-b.de (port-92-195-76-58.dynamic.qsc.de [92.195.76.58]) by mx01.qsc.de (Postfix) with ESMTP id 7289FDBD; Tue, 30 Apr 2013 16:53:43 +0200 (CEST) Message-ID: <517FDAF6.2060006@net-b.de> Date: Tue, 30 Apr 2013 16:53:42 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130329 Thunderbird/17.0.5 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] Permit allocatable/pointer attributes with BIND(C) X-Virus-Found: No TS29113 permits the allocatable/pointer attribute with BIND(C); this patch allows it now with -std=f2008ts. While the TS allows it also for scalars, this patch only permits it for arrays. The reason is that TS29113 requires the use of the array descriptor - and adding the support for scalars is something I would like to defer until the new descriptor is ready. (Similarly for character(len=:) and character(len=*) dummy arguments with Bind(C), which also use the array descriptor.) Build and regtested on x86-84-gnu-linux. OK for the trunk? Tobias PS: Admittedly, this feature is only of limited use on the trunk; however, for Fortran-dev, it is very useful. 2013-04-30 Tobias Burnus * decl.c (gfc_verify_c_interop_param): Permit allocatable and pointer with -std=f2008ts. 2013-04-30 Tobias Burnus * gfortran.dg/bind_c_array_params.f03: Update dg-error. * gfortran.dg/bind_c_usage_27.f90: New. * gfortran.dg/bind_c_usage_28.f90: New. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f9891c9..0187911 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1061,20 +1061,27 @@ gfc_verify_c_interop_param (gfc_symbol *sym) /* We have to make sure that any param to a bind(c) routine does not have the allocatable, pointer, or optional attributes, according to J3/04-007, section 5.1. */ - if (sym->attr.allocatable == 1) - { - gfc_error ("Variable '%s' at %L cannot have the " - "ALLOCATABLE attribute because procedure '%s'" - " is BIND(C)", sym->name, &(sym->declared_at), - sym->ns->proc_name->name); - retval = false; - } + if (sym->attr.allocatable == 1 + && !gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' at %L with " + "ALLOCATABLE attribute in procedure '%s' " + "with BIND(C)", sym->name, + &(sym->declared_at), + sym->ns->proc_name->name)) + retval = false; + + if (sym->attr.pointer == 1 + && !gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' at %L with " + "POINTER attribute in procedure '%s' " + "with BIND(C)", sym->name, + &(sym->declared_at), + sym->ns->proc_name->name)) + retval = false; - if (sym->attr.pointer == 1) + if ((sym->attr.allocatable || sym->attr.pointer) && !sym->as) { - gfc_error ("Variable '%s' at %L cannot have the " - "POINTER attribute because procedure '%s'" - " is BIND(C)", sym->name, &(sym->declared_at), + gfc_error ("Scalar variable '%s' at %L with POINTER or " + "ALLOCATABLE in procedure '%s' with BIND(C) is not yet" + " supported", sym->name, &(sym->declared_at), sym->ns->proc_name->name); retval = false; } diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 b/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 index 810f642..0e9903c 100644 --- a/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 +++ b/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 @@ -9,7 +9,7 @@ contains integer(c_int), dimension(:) :: assumed_array end subroutine sub0 - subroutine sub1(deferred_array) bind(c) ! { dg-error "cannot" } + subroutine sub1(deferred_array) bind(c) ! { dg-error "TS 29113: Variable 'deferred_array' at .1. with POINTER attribute in procedure 'sub1' with BIND.C." } integer(c_int), pointer :: deferred_array(:) end subroutine sub1 end module bind_c_array_params --- /dev/null 2013-04-30 09:21:48.687062896 +0200 +++ gcc/gcc/testsuite/gfortran.dg/bind_c_usage_27.f90 2013-04-30 16:13:02.245613916 +0200 @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-options "-std=f2008ts" } +! +! Contributed by Reinhold Bader +! +use iso_c_binding +type, bind(C) :: cstruct + integer :: i +end type +interface + subroutine psub(this, that) bind(c, name='Psub') + import :: c_float, cstruct + real(c_float), pointer :: this(:) + type(cstruct), allocatable :: that(:) + end subroutine psub + end interface +end --- /dev/null 2013-04-30 09:21:48.687062896 +0200 +++ gcc/gcc/testsuite/gfortran.dg/bind_c_usage_28.f90 2013-04-30 16:23:42.150000958 +0200 @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-options "-std=f2008" } +! +! Contributed by Reinhold Bader +! +use iso_c_binding +type, bind(C) :: cstruct + integer :: i +end type +interface + subroutine psub(this) bind(c, name='Psub') ! { dg-error "TS 29113: Variable 'this' at .1. with POINTER attribute in procedure 'psub' with BIND.C." } + import :: c_float, cstruct + real(c_float), pointer :: this(:) + end subroutine psub + subroutine psub2(that) bind(c, name='Psub2') ! { dg-error "TS 29113: Variable 'that' at .1. with ALLOCATABLE attribute in procedure 'psub2' with BIND.C." } + import :: c_float, cstruct + type(cstruct), allocatable :: that(:) + end subroutine psub2 + end interface +end