From patchwork Mon Jul 6 10:32:14 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 491532 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 B1E09140DB5 for ; Mon, 6 Jul 2015 20:32:37 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=E6ixQFXL; 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=kAZuXA2FbRKzVmqk Wm5eyxJPlNLUVsvjvoHkA6F60KzBEbTWhe0eDUvUf6ci8jJtpL1enybFeCwKbnaZ KbvNrfOm0+fvV17R20aoywPxFJtycfuNz/lcWQ4EvRetfEb2TG7r2CW8uRHnH4tJ J/B0OZiGoKH2+PGsA4CkKdi7NFI= 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=WW8Yb5xYge95JxkKZ/84Cw jGwU4=; b=E6ixQFXLbFBHh04AXGN2YHY+ZKrEJh4wk5mgUZMWGbcV9JwMS4eY1Z DX02Eh1n4SGM3jdEkGw7cQH4esuKfBg8+2YF37j97u6mCHpftcmyc5qeEwbFVLnX Eilfunl+9yWmkJM3xD07m+Q4b1GQPFtiIZsQNPur0cJuhFeC77X6Y= Received: (qmail 87944 invoked by alias); 6 Jul 2015 10:32:24 -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 87924 invoked by uid 89); 6 Jul 2015 10:32:24 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.2 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=no 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.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Mon, 06 Jul 2015 10:32:21 +0000 Received: from vepi2 ([84.63.202.252]) by mail.gmx.com (mrgmx102) with ESMTPSA (Nemesis) id 0MFi1J-1ZHqyb0iIf-00EcO5; Mon, 06 Jul 2015 12:32:16 +0200 Date: Mon, 6 Jul 2015 12:32:14 +0200 From: Andre Vehreschild To: Paul Richard Thomas Cc: Steve Kargl , GCC-Patches-ML , GCC-Fortran-ML Subject: Re: [commited, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value Message-ID: <20150706123214.5d1137be@vepi2> In-Reply-To: References: <20150505110026.7ecbc229@gmx.de> <554B3B23.3050800@sfr.fr> <20150508125444.50e234d6@gmx.de> <554CB85A.70901@sfr.fr> <20150508153146.75933da8@gmx.de> <20150508161111.33be9f14@gmx.de> <20150519160137.05580a36@vepi2> <20150703112900.1508b419@vepi2> <20150704162459.GA59514@troutmask.apl.washington.edu> <20150705161457.GA96406@troutmask.apl.washington.edu> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:wsBN8qhprl4=:CVuSe8SCh/RD1uLoBwCZYY dmFvEf8Czl/Q0SIbJtjeWWLmz+uyPOv3Pt+ph7q373WOQ7cHvOqClAo7m23Lc2VlxNLhb2jtD gMdx/QsaP/pjtcNQCu7nDqLTFExi2qy4gtvahRnL05udZZR4sj5XBhG5TrSjQ9ALJH7zekZbO /Gc/pwZV9HCeIi+5ROp+3p6cuaw3Ob8MFPIhDT7vRWJ/Kly8r2JciDCUx5aYMyiD4ypPLK/92 n+MxfMtyw1fsYHXvFlQGTKq9tfqL/wrym/hZ6aEniRmi4Ed7GZpxmlVhkkAq4YZDktt4/lBEQ 9zVYh95CvYAL/s0hAvhXAWS7fXj4NS1yixrbAC86Acmn154s/FrGu0l7fkSGa7qG9JBZBMhif ZYCKeXLAB8w1R+/hINDrU93GL3Dk/BhMEOMjDzyVt0IGJen9eMlJiBLy7YyHhkmvkeCQDT2hj 8i1t+EmS5/2cR9bF7SOVTpPa4PDsQef9vmPDjeajo97cKOhxbM5MtSSZKExJvdtbwBNkRwOiA RM9mLu5VhN3WIPjOef3efzy9Gk4i8hUVieHaVlK1Rq6eqa02wjXmp4QWrizXz7qLX0vJkXlUN m4PTXSMgd42RwhGEU4If5K4t4DdPS+XXyQOBd0EpN2xPfzSfwMiSgCV3nt2k6MY4tunx38OCX DmRyIMBExpWBD6uwXDUW80T8f7Ji85Jhhcb6H1ZyGWaArSg== Hi Steve, hi Paul, hi all, Steve and Paul, thank you very much for the reviews. Committed with the requested changes as r225447 and r225448. The last commit adds the Changelog entry in the testsuite I forgot. Sorry for that. For the open issue in the testcase I have opened the pr: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66775 Regards, Andre On Sun, 5 Jul 2015 19:48:13 +0200 Paul Richard Thomas wrote: > Dear Andre, > > I agree with Steve's recommendation that you comment out the line and > open a PR for the problem. > > The patch looks fine to me and applied cleanly, apart from trailing > CRs in the testcases. > > OK by me too. > > Cheers > > Paul > > PS I felt safe in setting a deadline for the submodule patch because: > (i) It was obvious that nobody would review it because of its size; > and (ii) It is safely ring-fenced by the need for very specific > procedure attributes and declarations. I would not dream of doing the > same for other patches more integrated in parts of the compiler that > are frequented by commonly used code. For example, the patch to > encompass the use of private entities with submodules will be just > such a patch.... when I figure out how to do it! I can sympathize with > you though; you have often had to wait an excessively long time for > reviews. > > > On 5 July 2015 at 18:14, Steve Kargl wrote: > > On Sat, Jul 04, 2015 at 09:20:39PM +0200, Andre Vehreschild wrote: > >> > >> Thanks for looking at the code. The error you experience is known > >> to me. The bug is present in gfortran and only exposed by this patch. > >> Unfortunately is the pr58586 not addressing this specific error. It > >> may be in the bugtracker under a different number already. Furthermore > >> did I not want to extend the patch for 58586 any further, because I > >> have learned that the more complicated a patch gets the longer review > >> takes. For making the testcase run fine we also simply can comment the > >> line. > >> > > > > I can appreciate the problem of fixing one bug may expose another, > > and I agree that holding up a patch for 58586 due to a latent bug > > seems unreasonable. I reviewed the email history and it appears > > that you've addressed Mikael's concerns. My only comment would > > be to comment out the problematic statement in alloc_comp_class_4.f03, > > and open a new bug report to record the issue. Ok to commit with > > my suggested change. > > > > -- > > Steve > > > Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 225446) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,3 +1,22 @@ +2015-07-06 Andre Vehreschild + + PR fortran/58586 + * resolve.c (resolve_symbol): Non-private functions in modules + with allocatable or pointer components are marked referenced + now. Furthermore is the default init especially for those + components now done in gfc_conf_procedure_call preventing + duplicate code. + * trans-decl.c (gfc_generate_function_code): Generate a fake + result decl for functions returning an object with allocatable + components and initialize them. + * trans-expr.c (gfc_conv_procedure_call): For value typed trees + use the tree without indirect ref. And for non-decl trees + add a temporary variable to prevent evaluating the tree + multiple times (prevent multiple function evaluations). + * trans.h: Made gfc_trans_structure_assign () protoype + available, which is now needed by trans-decl.c:gfc_generate_ + function_code(), too. + 2015-07-04 Steven G. Kargl PR fortran/66725 Index: gcc/fortran/trans-decl.c =================================================================== --- gcc/fortran/trans-decl.c (Revision 225446) +++ gcc/fortran/trans-decl.c (Arbeitskopie) @@ -5885,10 +5885,34 @@ tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); - if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) + if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node + || (sym->result && sym->result != sym + && sym->result->ts.type == BT_DERIVED + && sym->result->ts.u.derived->attr.alloc_comp)) { + bool artificial_result_decl = false; tree result = get_proc_result (sym); + gfc_symbol *rsym = sym == sym->result ? sym : sym->result; + /* 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->result->ts.type == BT_DERIVED + && (sym->attr.allocatable + || sym->attr.pointer + || sym->result->ts.u.derived->attr.alloc_comp + || sym->result->ts.u.derived->attr.pointer_comp)) + || (sym->result->ts.type == BT_CLASS + && (CLASS_DATA (sym)->attr.allocatable + || CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym->result)->attr.alloc_comp + || CLASS_DATA (sym->result)->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 @@ -5907,16 +5931,30 @@ 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; + /* Arrays are not initialized using the default initializer of + their elements. Therefore only check if a default + initializer is available when the result is scalar. */ + init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->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 (rsym->ts.u.derived->attr.alloc_comp) + { + rank = rsym->as ? rsym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (rsym->ts.u.derived, result, + rank); + gfc_prepend_expr_to_block (&body, 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) @@ -5926,7 +5964,7 @@ 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 ()); } Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (Revision 225446) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -14083,10 +14083,15 @@ 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 Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (Revision 225446) +++ gcc/fortran/trans-expr.c (Arbeitskopie) @@ -1465,7 +1465,6 @@ } -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 *); @@ -5340,8 +5339,19 @@ && 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 (!DECL_P (parmse.expr)) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (fsym && fsym->attr.value) + tmp = parmse.expr; + else + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parm_rank = e->rank; switch (parm_kind) { @@ -7158,7 +7168,7 @@ /* 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; @@ -7471,7 +7481,7 @@ if (expr->ts.type == BT_CHARACTER && expr->expr_type != EXPR_FUNCTION) gfc_conv_string_parameter (se); - else + else se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); return; Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (Revision 225446) +++ gcc/fortran/trans.h (Arbeitskopie) @@ -669,6 +669,9 @@ /* 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); Index: gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 =================================================================== --- gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 (Revision 0) +++ gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 (Revision 225447) @@ -0,0 +1,55 @@ +! { 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 + + type :: t + integer, allocatable :: comp + end type + type :: u + type(t), allocatable :: comp + 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()) + + call sub(u()) +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 + + subroutine sub(d) + type(u), value :: d + end subroutine +end program test_pr58586 + Index: gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 =================================================================== --- gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 (Revision 0) +++ gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 (Revision 225447) @@ -0,0 +1,105 @@ +! { 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 + + type t + integer :: i = 5 + end type + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + subroutine add_class_c (d) + class(c), value :: d + end subroutine + + subroutine add_t (d) + type(t), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + class(c) function c_init2() ! { dg-warning "not set" } + allocatable :: c_init2 + 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 + + type(t) function t_init() ! { dg-warning "not set" } + allocatable :: t_init + end function + + type(t) function static_t_init() ! { dg-warning "not set" } + end function +end module test_pr58586_mod + +program test_pr58586 + use test_pr58586_mod + + class(d), allocatable :: od + class(e), allocatable :: oe + type(t), allocatable :: temp + + ! 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()) + call add_class_c(c_init2()) + + call add_t(static_t_init()) + ! temp = t_init() ! <-- This derefs a null-pointer currently + ! Filed as pr66775 + if (allocated (temp)) call abort() + + allocate(od) + call add_c(od%init()) + deallocate(od) + allocate(oe) + call add_c(oe%init()) + deallocate(oe) +end program + Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 225446) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,9 @@ +2015-07-06 Andre Vehreschild + + PR fortran/58586 + * gfortran.dg/alloc_comp_class_3.f03: New test. + * gfortran.dg/alloc_comp_class_4.f03: New test. + 2015-07-06 Eric Botcazou * gcc.c-torture/execute/pr66757.c: New test.