From patchwork Thu Mar 8 14:13:09 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 145531 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 B5063B6EEE for ; Fri, 9 Mar 2012 01:13:46 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1331820827; h=Comment: DomainKey-Signature:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=/1luLaw ed7RGI7OBR0Zy1pqre8A=; b=ri1nbabcnwSJAU7DN6hkAJDpWtHjEcw8YgkHWQr EOzVHEN9G7ntNqZI28eNXx7QZvmnKSaWyEj1p5qjwsux5Tmh7lArInHgWlZd2aN1 HcSLqdlGx2Kc0m1ZlUcjgS/DVbAfZr1QW7woYDbPb8J9wrxVjjEUu8iajf5et+gB Yw7U= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:Subject:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=M6XZtQRsuFOV/j8KBOitp+O89zSQIyQrtYposo7U5kt8shwk22z1/86w6Ivbw2 kyH6zK4anhKGkcKGns/999zcxNwiPpvkZuQsPm85QilJJBLUmA6hkI6U8QyDEw18 D45qSrc73o1icHSv9x6L627eDKlKzbTRMmSY1Xj+mcIfM=; Received: (qmail 29827 invoked by alias); 8 Mar 2012 14:13:30 -0000 Received: (qmail 29810 invoked by uid 22791); 8 Mar 2012 14:13:28 -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; Thu, 08 Mar 2012 14:13:12 +0000 Received: from [192.168.178.22] (port-92-204-36-62.dynamic.qsc.de [92.204.36.62]) by mx02.qsc.de (Postfix) with ESMTP id 41BC71E286; Thu, 8 Mar 2012 15:13:09 +0100 (CET) Message-ID: <4F58BE75.3010201@net-b.de> Date: Thu, 08 Mar 2012 15:13:09 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:10.0.2) Gecko/20120215 Thunderbird/10.0.2 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 52469 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 After a lengthy debugging, I finally found the issue. If I hadn't be concentrating that much on -fwhole-file and if I had had a closer look at the test case before, I hadn't wasted hours tracking this one down ... The problem is that a procedure pointer is used for the "interface" of a procedure-pointer component. Instead of using the tree declaration of the proc-pointer target, the proc-pointer declaration was used as type - which caused a mess. (The patch is clearer than what I wrote above.) As the test case in the PR works without -fwhole-file (which enabled by default since 4.6), it is a 4.6/4.7/4.8 regression. Build and regtested on x86-64-Linux. OK for the trunk and the 4.6 and 4.7* branch? (* for 4.7.1) Tobias PS: The regtesting shows two unrelated failures: gfortran.dg/lto/pr45586-2 (PR fortran/45586) and gfortran.dg/realloc_on_assign_5.f03 (PR fortran/47674). PPS: Other patches which still need to be reviewed: * Cleanup fortran/convert.c, http://gcc.gnu.org/ml/fortran/2012-03/msg00036.html * Allow displaying backtraces from user code, http://gcc.gnu.org/ml/fortran/2012-03/msg00028.html * gfortran testsuite: implicitly cleanup-modules, http://gcc.gnu.org/ml/fortran/2012-03/msg00000.html * libfortran RFC: Shared vtables, constification, http://gcc.gnu.org/ml/fortran/2012-02/msg00067.html 2012-03-08 Tobias Burnus PR fortran/52469 * trans-types.c (gfc_get_function_type): Handle backend_decl of a procedure pointer. 2012-03-08 Tobias Burnus PR fortran/52469 * gfortran.dg/proc_ptr_34.f90 diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 6ff1d33..32fa2f4 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2678,7 +2692,11 @@ gfc_get_function_type (gfc_symbol * sym) || sym->attr.flavor == FL_PROGRAM); if (sym->backend_decl) - return TREE_TYPE (sym->backend_decl); + { + if (sym->attr.proc_pointer) + return TREE_TYPE (TREE_TYPE (sym->backend_decl)); + return TREE_TYPE (sym->backend_decl); + } alternate_return = 0; typelist = NULL; --- /dev/null 2012-03-08 07:42:36.287801550 +0100 +++ gcc/gcc/testsuite/gfortran.dg/proc_ptr_34.f90 2012-03-08 13:55:21.000000000 +0100 @@ -0,0 +1,79 @@ +! { dg-do compile } +! +! PR fortran/52469 +! +! This was failing as the DECL of the proc pointer "func" +! was used for the interface of the proc-pointer component "my_f_ptr" +! rather than the decl of the proc-pointer target +! +! Contributed by palott@gmail.com +! + +module ExampleFuncs + implicit none + + ! NOTE: "func" is a procedure pointer! + pointer :: func + interface + function func (z) + real :: func + real, intent (in) :: z + end function func + end interface + + type Contains_f_ptr + procedure (func), pointer, nopass :: my_f_ptr + end type Contains_f_ptr +contains + +function f1 (x) + real :: f1 + real, intent (in) :: x + + f1 = 2.0 * x + + return +end function f1 + +function f2 (x) + real :: f2 + real, intent (in) :: x + + f2 = 3.0 * x**2 + + return +end function f2 + +function fancy (func, x) + real :: fancy + real, intent (in) :: x + + interface AFunc + function func (y) + real :: func + real, intent (in) ::y + end function func + end interface AFunc + + fancy = func (x) + 3.3 * x +end function fancy + +end module ExampleFuncs + + +program test_proc_ptr + use ExampleFuncs + implicit none + + type (Contains_f_ptr), dimension (2) :: NewType + + !NewType(1) % my_f_ptr => f1 + NewType(2) % my_f_ptr => f2 + + !write (*, *) NewType(1) % my_f_ptr (3.0), NewType(2) % my_f_ptr (3.0) + write (6, *) NewType(2) % my_f_ptr (3.0) ! < Shall print '27.0' + + stop +end program test_proc_ptr + +! { dg-final { cleanup-modules "examplefuncs" } }