From patchwork Thu Sep 2 08:20:27 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 63452 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 73519B716D for ; Thu, 2 Sep 2010 18:21:03 +1000 (EST) Received: (qmail 28964 invoked by alias); 2 Sep 2010 08:20:53 -0000 Received: (qmail 28903 invoked by uid 22791); 2 Sep 2010 08:20:43 -0000 X-SWARE-Spam-Status: No, hits=-0.5 required=5.0 tests=AWL, BAYES_50, 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; Thu, 02 Sep 2010 08:20:37 +0000 Received: from [192.168.178.22] (port-92-204-46-222.dynamic.qsc.de [92.204.46.222]) by mx01.qsc.de (Postfix) with ESMTP id 880643DB1B; Thu, 2 Sep 2010 10:20:28 +0200 (CEST) Message-ID: <4C7F5E4B.3000800@net-b.de> Date: Thu, 02 Sep 2010 10:20:27 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.2.7) Gecko/20100714 SUSE/3.1.1 Thunderbird/3.1.1 MIME-Version: 1.0 To: gfortran , gcc patches Subject: [Patch, Fortran] PR 45489 - Default initialization of derived-type function result missing 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 Build and regtested on x86-64-linux. OK for the trunk - and for 4.5? How about 4.3/4.4? Tobias 2010-09-02 Tobias Burnus PR fortran/45489 * resolve.c (apply_default_init): Mark symbol as referenced, if it is initialized. (resolve_symbol): Change intialized check for BT_DERIVED such that also function results get initialized; remove now obsolete gfc_set_sym_referenced for BT_CLASS. 2010-09-02 Tobias Burnus PR fortran/45489 * gfortran.dg/initialization_27.f90: New. Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 163759) +++ gcc/fortran/resolve.c (working copy) @@ -9476,6 +9476,7 @@ apply_default_init (gfc_symbol *sym) return; build_init_assign (sym, init); + sym->attr.referenced = 1; } /* Build an initializer for a local integer, real, complex, logical, or @@ -12148,7 +12149,6 @@ resolve_symbol (gfc_symbol *sym) described in 14.7.5, to those variables that have not already been assigned one. */ if (sym->ts.type == BT_DERIVED - && sym->attr.referenced && sym->ns == gfc_current_ns && !sym->value && !sym->attr.allocatable @@ -12158,6 +12158,7 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc + && (a->referenced || a->result) && !(a->function && sym != sym->result)) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); @@ -12166,10 +12167,7 @@ resolve_symbol (gfc_symbol *sym) if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns && sym->attr.dummy && sym->attr.intent == INTENT_OUT && !sym->attr.pointer && !sym->attr.allocatable) - { - apply_default_init (sym); - gfc_set_sym_referenced (sym); - } + apply_default_init (sym); /* If this symbol has a type-spec, check it. */ if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER Index: gcc/testsuite/gfortran.dg/initialization_27.f90 =================================================================== --- gcc/testsuite/gfortran.dg/initialization_27.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/initialization_27.f90 (revision 0) @@ -0,0 +1,39 @@ +! { dg-do run} +! +! PR fortran/45489 +! +! Check that non-referenced variables are default +! initialized if they are INTENT(OUT) or function results. +! Only the latter (i.e. "x=f()") was not working before +! PR 45489 was fixed. +! +program test_init + implicit none + integer, target :: tgt + type A + integer, pointer:: p => null () + integer:: i=3 + end type A + type(A):: x, y(3) + x=f() + if (associated(x%p) .or. x%i /= 3) call abort () + y(1)%p => tgt + y%i = 99 + call sub1(3,y) + if (associated(y(1)%p) .or. any(y(:)%i /= 3)) call abort () + y(1)%p => tgt + y%i = 99 + call sub2(y) + if (associated(y(1)%p) .or. any(y(:)%i /= 3)) call abort () +contains + function f() result (fr) + type(A):: fr + end function f + subroutine sub1(n,x) + integer :: n + type(A), intent(out) :: x(n:n+2) + end subroutine sub1 + subroutine sub2(x) + type(A), intent(out) :: x(:) + end subroutine sub2 +end program test_init