From patchwork Sun Nov 6 16:12:41 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 80966 Delivered-To: patch@linaro.org Received: by 10.140.97.165 with SMTP id m34csp639969qge; Sun, 6 Nov 2016 08:13:20 -0800 (PST) X-Received: by 10.98.134.78 with SMTP id x75mr5789342pfd.6.1478448800860; Sun, 06 Nov 2016 08:13:20 -0800 (PST) Return-Path: Received: from sourceware.org (server1.sourceware.org. [209.132.180.131]) by mx.google.com with ESMTPS id h125si27288323pfb.24.2016.11.06.08.13.20 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sun, 06 Nov 2016 08:13:20 -0800 (PST) Received-SPF: pass (google.com: domain of gcc-patches-return-440541-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) client-ip=209.132.180.131; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org; spf=pass (google.com: domain of gcc-patches-return-440541-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) smtp.mailfrom=gcc-patches-return-440541-patch=linaro.org@gcc.gnu.org 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=ocVVHfuOgId9Snd4 NhAP+g1ZEJlLJEK5d/cF6e25bI/Tog/ccC8Ekv+syK+2LKTMz30e4OCp7e3Ee2VX gXqbfAG0VpUfndu/vNz4y89J6Xt6F4NC8NU4OseXeLUi1E79okIshA/PnwLn+gO3 IlEa7LuplHRcljPBnw9zObA7c+Q= 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=IukWiNf4UQiGqUEfacNDnL 7Vk+I=; b=lMLVRsAqaUDhrudBplf2ZbU8oVqWf/4dFjkBEj5lKnWWkVr/be3RmM shhRU9dJWIRqKV8I1Qluzk19mdBkbfs15M8FR9fIKIgxqo6ZZZpYjfNfkyanAO3b 3e59nL8aefIUZzeZ+X8NfGMvrio056rSi5Sj1PT/s2N24drX5uSck= Received: (qmail 103106 invoked by alias); 6 Nov 2016 16:13:05 -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 103082 invoked by uid 89); 6 Nov 2016 16:13:04 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.1 required=5.0 tests=AWL, BAYES_50, FREEMAIL_FROM, KAM_ASCII_DIVIDERS, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, RCVD_IN_SORBS_SPAM, SPF_PASS autolearn=no version=3.3.2 spammy=H*Ad:U*kargl, rank, sgktroutmaskaplwashingtonedu, sgk@troutmask.apl.washington.edu X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.19) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 06 Nov 2016 16:12:53 +0000 Received: from vepi2 ([84.59.211.84]) by mail.gmx.com (mrgmx001) with ESMTPSA (Nemesis) id 0M4GRv-1ctSW10LYp-00ro7b; Sun, 06 Nov 2016 17:12:42 +0100 Date: Sun, 6 Nov 2016 17:12:41 +0100 From: Andre Vehreschild To: Paul Richard Thomas Cc: kargl@uw.edu, GCC-Patches-ML , GCC-Fortran-ML , Dominique Dhumieres Subject: Re: [PATCH, Fortran, v1] Restructure initialization of allocatable components Message-ID: <20161106171241.36f37d07@vepi2> In-Reply-To: References: <20161103141648.1c8c87c3@vepi2> <20161104005752.GA19485@troutmask.apl.washington.edu> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:X10MsQEItZQ=:qvgwI0hbuqAYNiqyQ9UWIU og3TCN9WY9j00Yl8l5o2bngo9xnovOX2VOR10/6Hi4YoBTxUVoMAqXEaQ0KXih4j3RGU5QT68 gL9EtTTCj0ZhveqqnaCypk8FlRFoSHHvVXhVydX3KdKTDXGysQaicI3DcIc2DnOjnURjyc0Ye 82FphQuEL+rHrqEEocALToAiREnXrYTY+HrCwsulKdgIh9us+L4Jcsc/cEY/YD/Op/IZdIWhv gKoE5L703L/Q+f2AIh+Ek8dgOTy4qJtLPGVSYhXHHww6MNY+0ByhBE9WqCHGVcbQwIvTy26QF 74ZoWSo1imQjzuifGbW3NWO3gLQ80nHfiGH4FZ6rVjQT7bfUcFTGfS+0YsZGDl+UeCZVxMm+i ypyUQexQy9dZR7AbMu7M56DpoA5b83JplpMJwDosCbrYEVkU2b963VTUmu195nJfnKV43S9g6 G4YIB+DidjBMxoB41hl+NK2vl2QPt1j2MmG8sp49tmhmeRAcsOkfP4tLCS10McemC5fI07S4x T3gQznaFM7m3KdUvT+UN79gFnlcaof1rMP0/7OXX4S1MLpgtfT51Vk+y+zo1NzLrM/rY72Ovv xAkBnEoElQilfVc02ri4tDcOtjVFzvxF5+jMkZuydO2PFlf9MZRTiZw1CClk4Vgln4ikSMLN9 /brFYnNRrZGzUKjdHCdIZUpHVMNROsKkx3XHYhqMfFKa2+9zMW5osWNgnGh7MqCZnhLhvMjWD UyV+FntL7DTJ4IldJV3KQwsza4E3oPBCI7aVGilS2wnWRjmkVY9f568scYU= Hi Steve, hi Paul, hi Dominique, hi all, thanks for the reviews, Steve and Paul, thanks for the heavy testing, Dominique. Committed as r241885. Regards, Andre On Sat, 5 Nov 2016 10:46:46 +0100 Paul Richard Thomas wrote: > Dear Andre, > > The patch looks fine to me. OK for trunk. > > Cheers > > Paul > > On 4 November 2016 at 01:57, Steve Kargl > wrote: > > On Thu, Nov 03, 2016 at 02:16:48PM +0100, Andre Vehreschild wrote: > >> > >> Bootstraps and regtests fine on x86_64-linux/F23. Ok for trunk? > >> > >> @Dominique: Would you give it a go on your open patch collection? Maybe it > >> fixes one PR, but I am not very hopeful, because the patch is merely > >> removing complexity instead of doing new things. > >> > > > > Andre, > > > > I did not see anything that looked dubious. I think > > it is OK to commit, but you may want to see if Paul > > has any comment. > > > > -- > > Steve > > > -- Andre Vehreschild * Email: vehre ad gmx dot de Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 241884) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,3 +1,26 @@ +2016-11-06 Andre Vehreschild + + * expr.c (is_non_empty_structure_constructor): New function to detect + non-empty structure constructor. + (gfc_has_default_initializer): Analyse initializers. + * resolve.c (cond_init): Removed. + (resolve_allocate_expr): Removed dead code. Moved invariant code out + of the loop over all objects to allocate. + (resolve_allocate_deallocate): Added the invariant code remove from + resolve_allocate_expr. + * trans-array.c (gfc_array_allocate): Removed nullify of structure + components in favour of doing this in gfc_trans_allocate for both + scalars and arrays in the same place. + * trans-expr.c (gfc_trans_init_assign): Always using _vptr->copy for + class objects. + * trans-stmt.c (allocate_get_initializer): Get the initializer + expression for object allocated. + (gfc_trans_allocate): Nullify a derived type only, when no SOURCE= + or MOLD= is present preventing duplicate work. Moved the creation + of the init-expression here to prevent code for conditions that + can not occur on freshly allocated object, like checking for the need + to free allocatable components. + 2016-11-06 Thomas Koenig PR fortran/78221 Index: gcc/fortran/expr.c =================================================================== --- gcc/fortran/expr.c (Revision 241884) +++ gcc/fortran/expr.c (Arbeitskopie) @@ -4131,6 +4131,26 @@ } +/* Check whether an expression is a structure constructor and whether it has + other values than NULL. */ + +bool +is_non_empty_structure_constructor (gfc_expr * e) +{ + if (e->expr_type != EXPR_STRUCTURE) + return false; + + gfc_constructor *cons = gfc_constructor_first (e->value.constructor); + while (cons) + { + if (!cons->expr || cons->expr->expr_type != EXPR_NULL) + return true; + cons = gfc_constructor_next (cons); + } + return false; +} + + /* Check for default initializer; sym->value is not enough as it is also set for EXPR_NULL of allocatables. */ @@ -4145,7 +4165,9 @@ { if (!c->attr.pointer && !c->attr.proc_pointer && !(c->attr.allocatable && der == c->ts.u.derived) - && gfc_has_default_initializer (c->ts.u.derived)) + && ((c->initializer + && is_non_empty_structure_constructor (c->initializer)) + || gfc_has_default_initializer (c->ts.u.derived))) return true; if (c->attr.pointer && c->initializer) return true; Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (Revision 241884) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -7048,36 +7048,7 @@ return true; } -static void -cond_init (gfc_code *code, gfc_expr *e, int pointer, gfc_expr *init_e) -{ - gfc_code *block; - gfc_expr *cond; - gfc_code *init_st; - gfc_expr *e_to_init = gfc_expr_to_initialize (e); - cond = pointer - ? gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ASSOCIATED, - "associated", code->loc, 2, gfc_copy_expr (e_to_init), NULL) - : gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ALLOCATED, - "allocated", code->loc, 1, gfc_copy_expr (e_to_init)); - - init_st = gfc_get_code (EXEC_INIT_ASSIGN); - init_st->loc = code->loc; - init_st->expr1 = e_to_init; - init_st->expr2 = init_e; - - block = gfc_get_code (EXEC_IF); - block->loc = code->loc; - block->block = gfc_get_code (EXEC_IF); - block->block->loc = code->loc; - block->block->expr1 = cond; - block->block->next = init_st; - block->next = code->next; - - code->next = block; -} - /* Resolve the expression in an ALLOCATE statement, doing the additional checks to see whether the expression is OK or not. The expression must have a trailing array reference that gives the size of the array. */ @@ -7327,35 +7298,7 @@ /* We have to zero initialize the integer variable. */ code->expr3 = gfc_get_int_expr (gfc_default_integer_kind, &e->where, 0); } - else if (!code->expr3) - { - /* Set up default initializer if needed. */ - gfc_typespec ts; - gfc_expr *init_e; - if (gfc_bt_struct (code->ext.alloc.ts.type)) - ts = code->ext.alloc.ts; - else - ts = e->ts; - - if (ts.type == BT_CLASS) - ts = ts.u.derived->components->ts; - - if (gfc_bt_struct (ts.type) && (init_e = gfc_default_initializer (&ts))) - cond_init (code, e, pointer, init_e); - } - else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED) - { - /* Default initialization via MOLD (non-polymorphic). */ - gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts); - if (rhs != NULL) - { - gfc_resolve_expr (rhs); - gfc_free_expr (code->expr3); - code->expr3 = rhs; - } - } - if (e->ts.type == BT_CLASS && !unlimited && !UNLIMITED_POLY (code->expr3)) { /* Make sure the vtab symbol is present when @@ -7366,10 +7309,9 @@ else if (code->ext.alloc.ts.type == BT_DERIVED) ts = code->ext.alloc.ts; + /* Finding the vtab also publishes the type's symbol. Therefore this + statement is necessary. */ gfc_find_derived_vtab (ts.u.derived); - - if (dimension) - e = gfc_expr_to_initialize (e); } else if (unlimited && !UNLIMITED_POLY (code->expr3)) { @@ -7383,10 +7325,9 @@ gcc_assert (ts); + /* Finding the vtab also publishes the type's symbol. Therefore this + statement is necessary. */ gfc_find_vtab (ts); - - if (dimension) - e = gfc_expr_to_initialize (e); } if (dimension == 0 && codimension == 0) @@ -7690,6 +7631,22 @@ if (strcmp (fcn, "ALLOCATE") == 0) { bool arr_alloc_wo_spec = false; + + /* Resolving the expr3 in the loop over all objects to allocate would + execute loop invariant code for each loop item. Therefore do it just + once here. */ + if (code->expr3 && code->expr3->mold + && code->expr3->ts.type == BT_DERIVED) + { + /* Default initialization via MOLD (non-polymorphic). */ + gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts); + if (rhs != NULL) + { + gfc_resolve_expr (rhs); + gfc_free_expr (code->expr3); + code->expr3 = rhs; + } + } for (a = code->ext.alloc.list; a; a = a->next) resolve_allocate_expr (a->expr, code, &arr_alloc_wo_spec); Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (Revision 241884) +++ gcc/fortran/trans-expr.c (Arbeitskopie) @@ -10042,7 +10042,7 @@ tree gfc_trans_init_assign (gfc_code * code) { - return gfc_trans_assignment (code->expr1, code->expr2, true, false); + return gfc_trans_assignment (code->expr1, code->expr2, true, false, true); } tree Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (Revision 241884) +++ gcc/fortran/trans-array.c (Arbeitskopie) @@ -5623,14 +5623,6 @@ else gfc_add_expr_to_block (&se->pre, set_descriptor); - if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp - && !coarray) - { - tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr, - ref->u.ar.as->rank); - gfc_add_expr_to_block (&se->pre, tmp); - } - return true; } Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (Revision 241884) +++ gcc/fortran/trans-stmt.c (Arbeitskopie) @@ -5450,6 +5450,34 @@ } +/* Get the initializer expression for the code and expr of an allocate. + When no initializer is needed return NULL. */ + +static gfc_expr * +allocate_get_initializer (gfc_code * code, gfc_expr * expr) +{ + if (!gfc_bt_struct (expr->ts.type) && expr->ts.type != BT_CLASS) + return NULL; + + /* An explicit type was given in allocate ( T:: object). */ + if (code->ext.alloc.ts.type == BT_DERIVED + && (code->ext.alloc.ts.u.derived->attr.alloc_comp + || gfc_has_default_initializer (code->ext.alloc.ts.u.derived))) + return gfc_default_initializer (&code->ext.alloc.ts); + + if (gfc_bt_struct (expr->ts.type) + && (expr->ts.u.derived->attr.alloc_comp + || gfc_has_default_initializer (expr->ts.u.derived))) + return gfc_default_initializer (&expr->ts); + + if (expr->ts.type == BT_CLASS + && (CLASS_DATA (expr)->ts.u.derived->attr.alloc_comp + || gfc_has_default_initializer (CLASS_DATA (expr)->ts.u.derived))) + return gfc_default_initializer (&CLASS_DATA (expr)->ts); + + return NULL; +} + /* Translate the ALLOCATE statement. */ tree @@ -5456,7 +5484,7 @@ gfc_trans_allocate (gfc_code * code) { gfc_alloc *al; - gfc_expr *expr, *e3rhs = NULL; + gfc_expr *expr, *e3rhs = NULL, *init_expr; gfc_se se, se_sz; tree tmp; tree parm; @@ -6080,14 +6108,6 @@ label_finish, expr, 0); else gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat); - - if (al->expr->ts.type == BT_DERIVED - && expr->ts.u.derived->attr.alloc_comp) - { - tmp = build_fold_indirect_ref_loc (input_location, se.expr); - tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0); - gfc_add_expr_to_block (&se.pre, tmp); - } } else { @@ -6217,6 +6237,8 @@ fold_convert (TREE_TYPE (al_len), integer_zero_node)); } + + init_expr = NULL; if (code->expr3 && !code->expr3->mold && e3_is != E3_MOLD) { /* Initialization via SOURCE block (or static default initializer). @@ -6246,6 +6268,23 @@ gfc_free_statements (ini); gfc_add_expr_to_block (&block, tmp); } + else if ((init_expr = allocate_get_initializer (code, expr))) + { + /* Use class_init_assign to initialize expr. */ + gfc_code *ini; + int realloc_lhs = flag_realloc_lhs; + ini = gfc_get_code (EXEC_INIT_ASSIGN); + ini->expr1 = gfc_expr_to_initialize (expr); + ini->expr2 = init_expr; + flag_realloc_lhs = 0; + tmp= gfc_trans_init_assign (ini); + flag_realloc_lhs = realloc_lhs; + gfc_free_statements (ini); + /* Init_expr is freeed by above free_statements, just need to null + it here. */ + init_expr = NULL; + gfc_add_expr_to_block (&block, tmp); + } gfc_free_expr (expr); } // for-loop Index: gcc/testsuite/gfortran.dg/allocate_with_source_14.f03 =================================================================== --- gcc/testsuite/gfortran.dg/allocate_with_source_14.f03 (Revision 241884) +++ gcc/testsuite/gfortran.dg/allocate_with_source_14.f03 (Arbeitskopie) @@ -210,5 +210,5 @@ call v%free() deallocate(av) end program -! { dg-final { scan-tree-dump-times "__builtin_malloc" 23 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_malloc" 22 "original" } } ! { dg-final { scan-tree-dump-times "__builtin_free" 29 "original" } } Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 241884) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,8 @@ +2016-11-06 Andre Vehreschild + + * gfortran.dg/allocate_with_source_14.f03: Fixed number mallocs + occuring. + 2016-11-06 Thomas Koenig PR fortran/78221