From patchwork Fri Feb 18 20:45:15 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 83645 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 BEC32B711C for ; Sat, 19 Feb 2011 07:45:33 +1100 (EST) Received: (qmail 29328 invoked by alias); 18 Feb 2011 20:45:26 -0000 Received: (qmail 29264 invoked by uid 22791); 18 Feb 2011 20:45:24 -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 mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 18 Feb 2011 20:45:18 +0000 Received: from [192.168.178.22] (port-92-204-54-176.dynamic.qsc.de [92.204.54.176]) by mx01.qsc.de (Postfix) with ESMTP id ABF2B3CDB3; Fri, 18 Feb 2011 21:45:15 +0100 (CET) Message-ID: <4D5EDA5B.4040306@net-b.de> Date: Fri, 18 Feb 2011 21:45:15 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.13) Gecko/20101206 SUSE/3.1.7 Thunderbird/3.1.7 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 47775 - allocatable function RESULT and GENERIC 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 For pointer and allocatable returning functions, a temporary needs to be used. This check did not work for generic procedures as the generic and the specific function was checked. Result: Wrong code, fortunately often "already allocated" error. Build and regtested on x86-64-linux. OK for the trunk? To which versions one should backport? Allocatable function results have been introduced in 4.2 ... Tobias 2011-02-18 Tobias Burnus PR fortran/47775 * trans-expr.c (arrayfunc_assign_needs_temporary): Use esym to check whether the specific procedure returns an allocatable or pointer. 2011-02-18 Tobias Burnus PR fortran/47775 * gfortran.dg/func_result_6.f90: New. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b7d7ed9..fe7f03c 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5373,8 +5373,12 @@ arrayfunc_assign_needs_temporary (gfc_expr * expr1, gfc_expr * expr2) return true; /* Functions returning pointers need temporaries. */ - if (expr2->symtree->n.sym->attr.pointer - || expr2->symtree->n.sym->attr.allocatable) + c = expr2->value.function.esym + ? (expr2->value.function.esym->attr.pointer + || expr2->value.function.esym->attr.allocatable) + : (expr2->symtree->n.sym->attr.pointer + || expr2->symtree->n.sym->attr.allocatable); + if (c) return true; /* Character array functions need temporaries unless the --- /dev/null 2011-02-18 07:54:09.295999992 +0100 +++ gcc/gcc/testsuite/gfortran.dg/func_result_6.f90 2011-02-18 14:07:14.000000000 +0100 @@ -0,0 +1,73 @@ +! { dg-do run } +! +! PR fortran/47775 +! +! Contributed by Fran Martinez Fadrique +! +! Before, a temporary was missing for generic procedured (cf. test()) +! as the allocatable attribute was ignored for the check whether a +! temporary is required +! +module m +type t +contains + procedure, NOPASS :: foo => foo + generic :: gen => foo +end type t +contains + function foo(i) + integer, allocatable :: foo(:) + integer :: i + allocate(foo(2)) + foo(1) = i + foo(2) = i + 10 + end function foo +end module m + +use m +type(t) :: x +integer, pointer :: ptr1, ptr2 +integer, target :: bar1(2) +integer, target, allocatable :: bar2(:) + +allocate(bar2(2)) +ptr1 => bar1(2) +ptr2 => bar2(2) + +bar1 = x%gen(1) +if (ptr1 /= 11) call abort() +bar1 = x%foo(2) +if (ptr1 /= 12) call abort() +bar2 = x%gen(3) +if (ptr2 /= 13) call abort() +bar2 = x%foo(4) +if (ptr2 /= 14) call abort() +bar2(:) = x%gen(5) +if (ptr2 /= 15) call abort() +bar2(:) = x%foo(6) +if (ptr2 /= 16) call abort() + +call test() +end + +subroutine test +interface gen + procedure foo +end interface gen + +integer, target :: bar(2) +integer, pointer :: ptr +bar = [1,2] +ptr => bar(2) +if (ptr /= 2) call abort() +bar = gen() +if (ptr /= 77) call abort() +contains + function foo() + integer, allocatable :: foo(:) + allocate(foo(2)) + foo = [33, 77] + end function foo +end subroutine test + +! { dg-final { cleanup-modules "m" } }