From patchwork Wed Oct 20 21:40:42 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 68483 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]) by ozlabs.org (Postfix) with SMTP id 0E4F6B70CC for ; Thu, 21 Oct 2010 08:40:59 +1100 (EST) Received: (qmail 23925 invoked by alias); 20 Oct 2010 21:40:56 -0000 Received: (qmail 23908 invoked by uid 22791); 20 Oct 2010 21:40:54 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 20 Oct 2010 21:40:46 +0000 Received: from [192.168.178.22] (port-92-204-92-55.dynamic.qsc.de [92.204.92.55]) by mx02.qsc.de (Postfix) with ESMTP id 55E261D9E9; Wed, 20 Oct 2010 23:40:43 +0200 (CEST) Message-ID: <4CBF61DA.4090300@net-b.de> Date: Wed, 20 Oct 2010 23:40:42 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.9) Gecko/20100914 SUSE/3.1.4 Thunderbird/3.1.4 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 46100 - Allow pointer-function actuals in variable-definition contexts 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 In Fortran 2008, a pointer-function expression counts as variable. Thus, for a pointer-function "f()" and a procedure "sub" with has a nonpointer dummy, one can use call two (f()) even if the dummy argument of "sub" is used in a variable-definition context. Build and regtested on x86-64-linux. OK for the trunk? Tobias PS: F2008 also allows, e.g. "f() = 7" - but that's not yet supported by gfortran. 2010-10-20 Tobias Burnus PR fortran/46100 * expr.c (gfc_check_vardef_context): Treat pointer functions as variables. 2010-10-20 Tobias Burnus PR fortran/46100 * gfortran.dg/ptr-func-1.f90: New. * gfortran.dg/ptr-func-2.f90: New. diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 5711634..ef516a4 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4316,7 +4316,18 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context) symbol_attribute attr; gfc_ref* ref; - if (e->expr_type != EXPR_VARIABLE) + if (!pointer && e->expr_type == EXPR_FUNCTION + && e->symtree->n.sym->result->attr.pointer) + { + if (!(gfc_option.allow_std & GFC_STD_F2008)) + { + if (context) + gfc_error ("Fortran 2008: Pointer functions in variable definition" + " context (%s) at %L", context, &e->where); + return FAILURE; + } + } + else if (e->expr_type != EXPR_VARIABLE) { if (context) gfc_error ("Non-variable expression in variable definition context (%s)" diff --git a/gcc/testsuite/gfortran.dg/ptr-func-1.f90 b/gcc/testsuite/gfortran.dg/ptr-func-1.f90 new file mode 100644 index 0000000..b7c1fc9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ptr-func-1.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-std=f2008 -fall-intrinsics" } +! +! PR fortran/46100 +! +! Pointer function as definable actual argument +! - a Fortran 2008 feature +! +integer, target :: tgt +call one (two ()) +if (tgt /= 774) call abort () +contains + subroutine one (x) + integer, intent(inout) :: x + if (x /= 34) call abort () + x = 774 + end subroutine one + function two () + integer, pointer :: two + two => tgt + two = 34 + end function two +end + diff --git a/gcc/testsuite/gfortran.dg/ptr-func-2.f90 b/gcc/testsuite/gfortran.dg/ptr-func-2.f90 new file mode 100644 index 0000000..8275f14 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ptr-func-2.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-std=f2003 -fall-intrinsics" } +! +! PR fortran/46100 +! +! Pointer function as definable actual argument +! - a Fortran 2008 feature +! +integer, target :: tgt +call one (two ()) ! { dg-error "Fortran 2008: Pointer functions" } +if (tgt /= 774) call abort () +contains + subroutine one (x) + integer, intent(inout) :: x + if (x /= 34) call abort () + x = 774 + end subroutine one + function two () + integer, pointer :: two + two => tgt + two = 34 + end function two +end +