From patchwork Thu Apr 23 18:00:52 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 464014 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id EBBB014011D for ; Fri, 24 Apr 2015 04:01:12 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass reason="1024-bit key; unprotected key" header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=L4VfwWr2; dkim-adsp=none (unprotected policy); dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; q=dns; s=default; b=AL2LrqVgGYPMVxSz i6vBiNRdwnmfMo+fHPAQqQBZNi6vQT1y7S67SEyiY9mbnIzAcpJSi/P8oHOsFT9q IhHyWj8jPvX1SLi/Nf2zgTNKYZ+iByoM+kdHiC+WMbglHCEDADtK76PNGEjlDp+T nc27OZQWF+VGsoalv5QeShkHdPA= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; s=default; bh=ShXC1F+bneOdWmElo+zyJl l4xQo=; b=L4VfwWr27yAzSePczdP30O5DkZxkg4/uvRXG9+g75ZKk/wdLu7Wiid UagSNi8P7bnabps6IKnT/+Rjfka1/lJmLMI/ovwpUOd4mC0QCe4JMRFOVHRH4LFp GjLup6wMQ4G7VDfG7goXiQtK97Jv4NbGFrJf7iicCm77wYcjRkk4o= Received: (qmail 73008 invoked by alias); 23 Apr 2015 18:01:02 -0000 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 Received: (qmail 72981 invoked by uid 89); 23 Apr 2015 18:01:01 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.4 required=5.0 tests=AWL, BAYES_50, FREEMAIL_FROM, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.17.22) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Thu, 23 Apr 2015 18:00:59 +0000 Received: from localhost ([88.75.104.20]) by mail.gmx.com (mrgmx101) with ESMTPSA (Nemesis) id 0M0LtB-1Zaz751D2b-00ubfV; Thu, 23 Apr 2015 20:00:54 +0200 Date: Thu, 23 Apr 2015 20:00:52 +0200 From: Andre Vehreschild To: Mikael Morin Cc: GCC-Patches-ML , GCC-Fortran-ML Subject: Re: [Patch, Fortran, PR58586, v2] ICE with derived type with allocatable component passed by value Message-ID: <20150423200052.2e7a1311@gmx.de> In-Reply-To: <55337CF3.9010002@sfr.fr> References: <20150415200304.7101aca9@gmx.de> <55337CF3.9010002@sfr.fr> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; Hi Mikael, hi all, thanks for the review. I have made some changes. Answers to your questions are inline below. On Sun, 19 Apr 2015 12:01:23 +0200 Mikael Morin wrote: > > I was pointed to the patch in comment #44 of pr61831 which seemingly fixes > > the #3 comment of pr58586, too, but causes a memory leak. I therefore like > > to point out, that adding the a->expr.expr_type != EXPR_STRUCTURE of > > Mikael's patch in pr61831 should not be added to > > trans-expr.c::gfc_conv_procedure_call (), when this patch for 58586 is > > applied. > Note that I plan to submit the pr61831 patch soon, and that the comment > #44 patch doesn't have the a->expr.expr_type != EXPR_STRUCTURE (in > opposition to precedent patches). > I hope that means the patches are compatible. ;-) I have tested the code in the comments of pr61831 with v2 of this patch and got no issues. > > diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c > > index 9e6432f..80dfed1 100644 > > --- a/gcc/fortran/trans-expr.c > > +++ b/gcc/fortran/trans-expr.c > > @@ -5344,8 +5344,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * > > sym, && (e->expr_type != EXPR_VARIABLE && !e->rank)) > > { > > int parm_rank; > > - tmp = build_fold_indirect_ref_loc (input_location, > > - parmse.expr); > > + /* It is known the e returns a structure type with at least one > > + allocatable component. When e is a function, ensure that the > > + function is called once only by using a temporary variable. > > */ > > + if (e->expr_type == EXPR_FUNCTION) > > + parmse.expr = gfc_evaluate_now_loc (input_location, > > + parmse.expr, &se->pre); > You need not limit this to functions only. > I think you can even do this without condition. Yes, one could do that, but then an unnecessary temporary variable in the - for my taste - already too clobbered pseudo code is introduced. Furthermore, is the penalty on doing the check for a function negligible. I therefore have not changed that. > > + if (POINTER_TYPE_P (TREE_TYPE (parmse.expr))) > This distinguishes arguments with/without value attribute, right? > I think it's better to use the frontend information here (fsym->attr.value). Changed to check for value. > Ah, and don't forget to provide a ChangeLog entry with it. The Changelog entry comes in an additional attachment. Version 2 of this patch adds a chunk to resolve.c, where results of functions that are defined in a module, but are not referenced there, are now marked referenced when they use allocatable or pointer components. Furthermore, does the chunk prevent duplicate pseudo code generation. The former code adds a EXPR_INIT_ASSIGN and then gfc_generate_function_code () does nearly the same again. I fixed this in both place. I also have added a test to check this. The chunks in trans-decl.c take care to have variable/result declaration and initialize it properly. For this I had to make gfc_trans_structure_assign () public to the trans-stage. Bootstraps and regtests ok on x86_64-linux-gnu/F21. Ok, for trunk? Regards, Andre diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 76afd72..a43396c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14063,10 +14063,15 @@ 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->result && !a->function) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); + else if (a->function && sym->result && a->access != ACCESS_PRIVATE + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + /* Mark the result symbol to be referenced, when it has allocatable + components. */ + sym->result->attr.referenced = 1; } if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4c18920..0b63175 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global) gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym)); sym->backend_decl = fndecl; + if (sym == sym->result && !sym->result->backend_decl) + sym->result->backend_decl = result_decl; } @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns) if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) { + bool artificial_result_decl = false; tree result = get_proc_result (sym); + /* Make sure that a function returning an object with + alloc/pointer_components always has a result, where at least + the allocatable/pointer components are set to zero. */ + if (result == NULL_TREE && sym->attr.function + && sym->ts.type == BT_DERIVED + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + { + artificial_result_decl = true; + result = gfc_get_fake_result_decl (sym, 0); + } + if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer) { if (sym->attr.allocatable && sym->attr.dimension == 0 @@ -5918,16 +5933,26 @@ gfc_generate_function_code (gfc_namespace * ns) null_pointer_node)); } else if (sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.alloc_comp && !sym->attr.allocatable) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&init, tmp); + gfc_expr *init_exp; + init_exp = gfc_default_initializer (&sym->ts); + if (init_exp) + { + tmp = gfc_trans_structure_assign (result, init_exp, 0); + gfc_free_expr (init_exp); + gfc_add_expr_to_block (&init, tmp); + } + else if (sym->ts.u.derived->attr.alloc_comp) + { + rank = sym->as ? sym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); + gfc_add_expr_to_block (&init, tmp); + } } } - if (result == NULL_TREE) + if (result == NULL_TREE || artificial_result_decl) { /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && sym == sym->result) @@ -5937,7 +5962,7 @@ gfc_generate_function_code (gfc_namespace * ns) if (warn_return_type) TREE_NO_WARNING(sym->backend_decl) = 1; } - else + if (result != NULL_TREE) gfc_add_expr_to_block (&body, gfc_generate_return ()); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9e6432f..2db7524 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where) } -static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init); static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *, gfc_expr *); @@ -5344,8 +5343,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && (e->expr_type != EXPR_VARIABLE && !e->rank)) { int parm_rank; - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + /* It is known the e returns a structure type with at least one + allocatable component. When e is a function, ensure that the + function is called once only by using a temporary variable. */ + if (e->expr_type == EXPR_FUNCTION) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (fsym->attr.value) + tmp = parmse.expr; + else + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parm_rank = e->rank; switch (parm_kind) { @@ -7136,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, /* Assign a derived type constructor to a variable. */ -static tree +tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) { gfc_constructor *c; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index e2a1fea..3198c55 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -666,6 +666,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); +/* Assign a derived type constructor to a variable. */ +tree gfc_trans_structure_assign (tree, gfc_expr *, bool); + /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 new file mode 100644 index 0000000..28c0beb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 @@ -0,0 +1,42 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +program test_pr58586 + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: b + integer, allocatable :: a + end type + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function +end program test_pr58586 + diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 new file mode 100644 index 0000000..578df83 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 @@ -0,0 +1,74 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +module test_pr58586_mod + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: d + contains + procedure :: init => d_init + end type + + type, extends(d) :: e + contains + procedure :: init => e_init + end type + + type :: b + integer, allocatable :: a + end type + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + type(c) function d_init(this) ! { dg-warning "not set" } + class(d) :: this + end function + + type(c) function e_init(this) + class(e) :: this + allocate (e_init%a) + end function +end module test_pr58586_mod + +program test_pr58586 + use test_pr58586_mod + + class(d), allocatable :: od + class(e), allocatable :: oe + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + + allocate(od) + call add_c(od%init()) + deallocate(od) + allocate(oe) + call add_c(oe%init()) + deallocate(oe) +end program +