From patchwork Sun Aug 15 15:02:19 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 61749 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 9B25BB70A7 for ; Mon, 16 Aug 2010 01:35:44 +1000 (EST) Received: (qmail 11000 invoked by alias); 15 Aug 2010 15:35:37 -0000 Received: (qmail 10809 invoked by uid 22791); 15 Aug 2010 15:35:36 -0000 X-SWARE-Spam-Status: No, hits=-1.9 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; Sun, 15 Aug 2010 15:35:27 +0000 Received: from [192.168.178.22] (port-92-204-42-5.dynamic.qsc.de [92.204.42.5]) by mx02.qsc.de (Postfix) with ESMTP id 508221E270; Sun, 15 Aug 2010 17:02:19 +0200 (CEST) Message-ID: <4C68017B.8070407@net-b.de> Date: Sun, 15 Aug 2010 17:02:19 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.7) Gecko/20100714 SUSE/3.1.1 Thunderbird/3.1.1 MIME-Version: 1.0 To: gcc patches , gfortran , Daniel Kraft Subject: [Patch, Fortran] F2008: TARGET actual to POINTER dummy with INTENT(IN) 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 Low-hanging but useful Fortran 2008 feature. F2008 allows passing a TARGET to a POINTER dummy which has INTENT(IN). F2008, 12.5.2.7 Pointer dummy variables: "If the dummy argument does not have the INTENT (IN), the actual argument shall be a pointer. Otherwise, the actual argument shall be a pointer or a valid target for the dummy pointer in a pointer assignment statement." Build and regtested on x86-64-linux. OK for the trunk? Tobias 2010-08-15 Tobias Burnus * interface.c (compare_pointer, ): Allow passing TARGETs to pointers dummies with intent(in). 2010-08-15 Tobias Burnus * gfortran.dg/pointer_target_1.f90: New. * gfortran.dg/pointer_target_2.f90: New. * gfortran.dg/pointer_target_3.f90: New. Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (Revision 163252) +++ gcc/fortran/interface.c (Arbeitskopie) @@ -1368,6 +1368,11 @@ compare_pointer (gfc_symbol *formal, gfc if (formal->attr.pointer) { attr = gfc_expr_attr (actual); + + /* Fortran 2008 allows non-pointer actual arguments. */ + if (!attr.pointer && attr.target && formal->attr.intent == INTENT_IN) + return 2; + if (!attr.pointer) return 0; } @@ -2113,6 +2133,17 @@ compare_actual_formal (gfc_actual_arglis return 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 '%s'", &a->expr->where,f->sym->name); + return 0; + } + + /* Fortran 2008, C1242. */ if (f->sym->attr.pointer && gfc_is_coindexed (a->expr)) { Index: gcc/testsuite/gfortran.dg/pointer_target_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pointer_target_1.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/pointer_target_1.f90 (Revision 0) @@ -0,0 +1,20 @@ +! { dg-do run } +! +! TARGET actual to POINTER dummy with INTENT(IN) +! +program test + implicit none + integer, target :: a + a = 66 + call foo(a) + if (a /= 647) call abort() +contains + subroutine foo(p) + integer, pointer, intent(in) :: p + if (a /= 66) call abort() + if (p /= 66) call abort() + p = 647 + if (p /= 647) call abort() + if (a /= 647) call abort() + end subroutine foo +end program test Index: gcc/testsuite/gfortran.dg/pointer_target_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pointer_target_2.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/pointer_target_2.f90 (Revision 0) @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! +! TARGET actual to POINTER dummy with INTENT(IN) +! +program test + implicit none + integer, target :: a + a = 66 + call foo(a) ! { dg-error "Fortran 2008: Non-pointer actual argument" } + if (a /= 647) call abort() +contains + subroutine foo(p) + integer, pointer, intent(in) :: p + if (a /= 66) call abort() + if (p /= 66) call abort() + p = 647 + if (p /= 647) call abort() + if (a /= 647) call abort() + end subroutine foo +end program test Index: gcc/testsuite/gfortran.dg/pointer_target_3.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pointer_target_3.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/pointer_target_3.f90 (Revision 0) @@ -0,0 +1,20 @@ +! { dg-do compile } +! +! TARGET actual to POINTER dummy with INTENT(IN) +! +program test + implicit none + integer, target :: a + integer :: b + call foo(a) ! OK + call foo(b) ! { dg-error "must be a pointer" } + call bar(a) ! { dg-error "must be a pointer" } + call bar(b) ! { dg-error "must be a pointer" } +contains + subroutine foo(p) + integer, pointer, intent(in) :: p + end subroutine foo + subroutine bar(p) + integer, pointer :: p + end subroutine bar +end program test