From patchwork Sun Oct 25 12:31:02 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 535555 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 7DB7014130B for ; Sun, 25 Oct 2015 23:31:24 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=rGkV7noo; 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=lys71gJqOlxTL3MS 65r/qMGGNqmjI/rRs2OUyj8mQEKzsZklOjgfQTaQnysfusCzJKvuNHVmPbfAuOhw YM6X2W1YeMqeoOLyUr12jQG2pJdSv66ktpum9w4TVFgJZsIQezQuvphbjuydgSeI MJpMdHLcjXzqbN8JZLLIm2cqjQw= 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=E2odOWbzIcOt6lNO8UW7SO RdsKw=; b=rGkV7noo4rmQUJPJB/p+31tkTRmofGKbvjKHm8gYmjj/TgVmpFUcFc kk4oXcjavcxqlXRw0oS3X9cmwUuWsPygXsmvMbL91vlFuc+HmgrCh2jRUotUx7G6 zL4r4SUydblPDAlzQyGasxsSIA1Ka+qU3gMDITs0+Ci65jJnjQuKM= Received: (qmail 93449 invoked by alias); 25 Oct 2015 12:31:13 -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 93431 invoked by uid 89); 25 Oct 2015 12:31:12 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.0 required=5.0 tests=AWL, BAYES_50, FREEMAIL_FROM, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_LOW, 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.15.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Sun, 25 Oct 2015 12:31:09 +0000 Received: from vepi2 ([92.213.0.123]) by mail.gmx.com (mrgmx002) with ESMTPSA (Nemesis) id 0MSv6D-1ZyGxe2ryP-00RtjK; Sun, 25 Oct 2015 13:31:04 +0100 Date: Sun, 25 Oct 2015 13:31:02 +0100 From: Andre Vehreschild To: Paul Richard Thomas Cc: Dominique =?UTF-8?B?ZCdIdW1pw6hyZXM=?= , gcc-patches , Mikael Morin , GNU GFortran Subject: Re: [Patch, Fortran, 66927, v2] [6 Regression] ICE in gfc_conf_procedure_call Message-ID: <20151025133102.2aa5ebd6@vepi2> In-Reply-To: References: MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:5uVS2tdVoTc=:2qtEuj9ayqlSAz3fQUQmVY z2CDFI+1XS2WuVSaiS9Trz2n//8T2yjdBQsMfnIGdPBCNdVMPOyKJ4/SQSjiZ6bdEMtkz+ODi TCcuOdMIbcramDkm8U4EWb9zj85dQ4GZtEOMFV2j2wmfQueDugsqVicp5VwoYo+wRaauxzgMp s0htPSzA7QmfpXJkUXzVsbH+SZjSAngyTIWrId9qpIO76kF30vWk4HMR5AZYpRLiAgWxuvlOt Ecgjvq5wDaptDUCT8iffcdDHRnCvPacLAssdev7dwwje1XQyaJnEnSKh8Q23w2bIqYXjnGCzC W5C6BBEVarEUN9mMtjMQN7LltF05d5ncKxXshB42IyZK8YVMds1I88tsM7sjM6zaj2xCFm433 +lDRub8bpyHd7QVbuHVfu8YwVFcHlaQDccuKGEbhiQqxda3HchuPUQb9TmupD6vwkZSKoRD2g efFoUIc1QCr7UjZAhP70PIK9GD5+1HH/IrtbvkvY2zMlK7rLa3nxInX3B5uQRhUJi5GNNr+1T eNHSzwz8ClCW0nXpAL0/tsfwax9aAnVoGDBNCgfrwzqDOT03/fuVc8gpOItvz1HlUNrlJR5bL gZLQak97rkjiT2Ni3GZSAEKotOG15FbW9t+gn4aSYgclGGJwaPrh07F7WliLxBdetDtbEYQ5K hRe2wmXHidPpdQBOGhfVPbtLtjjAxSD4yYA94dOnb7gVBxReGbrYy9aC89fyXTdSvKnb4ixiN GaqyDj2q/QB2+LQXau8m1fmeOQIvQE5RARBZ0Y1zwrHK/qET6rw9jUUrLKo= Hi Paul, hi all, thanks for the review. Submitted as r229294. Regards, Andre On Sun, 25 Oct 2015 08:43:24 +0100 Paul Richard Thomas wrote: > Dear Andre, > > As far as I can see, the problems with PR57117 are specific to RESHAPE > and need not affect committing your patch. To my surprise, the > combination of your patch and mine for PR67171 fixes PR67044 in that > the ICE no longer occurs. I have to get my head around how to write a > testcase for it that tests the functionality though! > > You can commit this patch to trunk. As I said elsewhere, I will rename > the testcase for PR67171. > > Many thanks for the patch. > > Paul > > On 23 October 2015 at 09:44, Paul Richard Thomas > wrote: > > Dear Andre, > > > > I will wait until you fix the problems that Dominique has pointed out. > > However, if by Sunday afternoon (rain forecast!) you haven't found the > > time, I will see if I can locate the source of these new problems. > > > > With best regards > > > > Paul > > > > On 7 October 2015 at 19:51, Dominique d'Humières wrote: > >> This patch also fixes pr57117 comment 2, the original test and the test in comment 3 now give an ICE > >> > >> pr57117.f90:82:0: > >> > >> allocate(z(9), source=reshape(x, (/ 9 /))) > >> 1 > >> internal compiler error: Segmentation fault: 11 > >> > >> and pr67044. > >> > >> Thanks, > >> > >> Dominique > >> > > > > > > > > -- > > Outside of a dog, a book is a man's best friend. Inside of a dog it's > > too dark to read. > > > > Groucho Marx > > > Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (Revision 229293) +++ gcc/fortran/trans.h (Arbeitskopie) @@ -378,7 +378,7 @@ void gfc_reset_vptr (stmtblock_t *, gfc_expr *); void gfc_reset_len (stmtblock_t *, gfc_expr *); tree gfc_get_vptr_from_expr (tree); -tree gfc_get_class_array_ref (tree, tree); +tree gfc_get_class_array_ref (tree, tree, tree); tree gfc_copy_class_to_class (tree, tree, tree, bool); bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *); bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool); Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (Revision 229293) +++ gcc/fortran/trans-array.c (Arbeitskopie) @@ -3250,7 +3250,7 @@ { type = gfc_get_element_type (type); tmp = TREE_OPERAND (cdecl, 0); - tmp = gfc_get_class_array_ref (offset, tmp); + tmp = gfc_get_class_array_ref (offset, tmp, NULL_TREE); tmp = fold_convert (build_pointer_type (type), tmp); tmp = build_fold_indirect_ref_loc (input_location, tmp); return tmp; @@ -7107,9 +7107,20 @@ } else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)) || se->use_offset) { + bool toonebased; tmp = gfc_conv_array_lbound (desc, n); + toonebased = integer_onep (tmp); + // lb(arr) - from (- start + 1) tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (base), tmp, from); + if (onebased && toonebased) + { + tmp = fold_build2_loc (input_location, MINUS_EXPR, + TREE_TYPE (base), tmp, start); + tmp = fold_build2_loc (input_location, PLUS_EXPR, + TREE_TYPE (base), tmp, + gfc_index_one_node); + } tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (base), tmp, gfc_conv_array_stride (desc, n)); @@ -7183,12 +7194,13 @@ /* For class arrays add the class tree into the saved descriptor to enable getting of _vptr and the like. */ if (expr->expr_type == EXPR_VARIABLE && VAR_P (desc) - && IS_CLASS_ARRAY (expr->symtree->n.sym) - && DECL_LANG_SPECIFIC (expr->symtree->n.sym->backend_decl)) + && IS_CLASS_ARRAY (expr->symtree->n.sym)) { gfc_allocate_lang_decl (desc); GFC_DECL_SAVED_DESCRIPTOR (desc) = - GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl); + DECL_LANG_SPECIFIC (expr->symtree->n.sym->backend_decl) ? + GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl) + : expr->symtree->n.sym->backend_decl; } if (!se->direct_byref || se->byref_noassign) { Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (Revision 229293) +++ gcc/fortran/trans-expr.c (Arbeitskopie) @@ -1039,9 +1039,10 @@ of the referenced element. */ tree -gfc_get_class_array_ref (tree index, tree class_decl) +gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp) { - tree data = gfc_class_data_get (class_decl); + tree data = data_comp != NULL_TREE ? data_comp : + gfc_class_data_get (class_decl); tree size = gfc_class_vtab_size_get (class_decl); tree offset = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, @@ -1075,6 +1076,7 @@ tree stdcopy; tree extcopy; tree index; + bool is_from_desc = false, is_to_class = false; args = NULL; /* To prevent warnings on uninitialized variables. */ @@ -1088,7 +1090,19 @@ fcn_type = TREE_TYPE (TREE_TYPE (fcn)); if (from != NULL_TREE) - from_data = gfc_class_data_get (from); + { + is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from)); + if (is_from_desc) + { + from_data = from; + from = GFC_DECL_SAVED_DESCRIPTOR (from); + } + else + { + from_data = gfc_class_data_get (from); + is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data)); + } + } else from_data = gfc_class_vtab_def_init_get (to); @@ -1100,9 +1114,16 @@ from_len = integer_zero_node; } - to_data = gfc_class_data_get (to); - if (unlimited) - to_len = gfc_class_len_get (to); + if (GFC_CLASS_TYPE_P (TREE_TYPE (to))) + { + is_to_class = true; + to_data = gfc_class_data_get (to); + if (unlimited) + to_len = gfc_class_len_get (to); + } + else + /* When to is a BT_DERIVED and not a BT_CLASS, then to_data == to. */ + to_data = to; if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (to_data))) { @@ -1118,15 +1139,23 @@ nelems = gfc_evaluate_now (tmp, &body); index = gfc_create_var (gfc_array_index_type, "S"); - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data))) + if (is_from_desc) { - from_ref = gfc_get_class_array_ref (index, from); + from_ref = gfc_get_class_array_ref (index, from, from_data); vec_safe_push (args, from_ref); } else vec_safe_push (args, from_data); - to_ref = gfc_get_class_array_ref (index, to); + if (is_to_class) + to_ref = gfc_get_class_array_ref (index, to, to_data); + else + { + tmp = gfc_conv_array_data (to); + tmp = build_fold_indirect_ref_loc (input_location, tmp); + to_ref = gfc_build_addr_expr (NULL_TREE, + gfc_build_array_ref (tmp, index, to)); + } vec_safe_push (args, to_ref); tmp = build_call_vec (fcn_type, fcn, args); @@ -1183,7 +1212,7 @@ } else { - gcc_assert (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data))); + gcc_assert (!is_from_desc); vec_safe_push (args, from_data); vec_safe_push (args, to_data); stdcopy = build_call_vec (fcn_type, fcn, args); Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 229293) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,3 +1,20 @@ +2015-10-25 Andre Vehreschild + + PR fortran/66927 + PR fortran/67044 + * trans-array.c (build_array_ref): Modified call to + gfc_get_class_array_ref to adhere to new interface. + (gfc_conv_expr_descriptor): For one-based arrays that + are filled by a loop starting at one the start index of the + source array has to be mangled into the offset. + * trans-expr.c (gfc_get_class_array_ref): When the tree to get + the _data component is present already, add a way to supply it. + (gfc_copy_class_to_class): Allow to copy to a derived type also. + * trans-stmt.c (gfc_trans_allocate): Do not conv_expr_descriptor + for functions returning a class or derived object. Get the + reference instead. + * trans.h: Interface change of gfc_get_class_array_ref. + 2015-10-24 Steven G. Kargl PR fortran/68055 Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (Revision 229293) +++ gcc/fortran/trans-stmt.c (Arbeitskopie) @@ -5186,9 +5186,16 @@ /* In all other cases evaluate the expr3. */ symbol_attribute attr; /* Get the descriptor for all arrays, that are not allocatable or - pointer, because the latter are descriptors already. */ + pointer, because the latter are descriptors already. + The exception are function calls returning a class object: + The descriptor is stored in their results _data component, which + is easier to access, when first a temporary variable for the + result is created and the descriptor retrieved from there. */ attr = gfc_expr_attr (code->expr3); - if (code->expr3->rank != 0 && !attr.allocatable && !attr.pointer) + if (code->expr3->rank != 0 + && ((!attr.allocatable && !attr.pointer) + || (code->expr3->expr_type == EXPR_FUNCTION + && code->expr3->ts.type != BT_CLASS))) gfc_conv_expr_descriptor (&se, code->expr3); else gfc_conv_expr_reference (&se, code->expr3); @@ -5205,17 +5212,40 @@ variable declaration. */ if (se.expr != NULL_TREE && temp_var_needed) { - tree var; + tree var, desc; tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) ? se.expr : build_fold_indirect_ref_loc (input_location, se.expr); + + /* Get the array descriptor and prepare it to be assigned to the + temporary variable var. For classes the array descriptor is + in the _data component and the object goes into the + GFC_DECL_SAVED_DESCRIPTOR. */ + if (code->expr3->ts.type == BT_CLASS + && code->expr3->rank != 0) + { + /* When an array_ref was in expr3, then the descriptor is the + first operand. */ + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + { + desc = TREE_OPERAND (tmp, 0); + } + else + { + desc = tmp; + tmp = gfc_class_data_get (tmp); + } + e3_is = E3_DESC; + } + else + desc = se.expr; /* We need a regular (non-UID) symbol here, therefore give a prefix. */ var = gfc_create_var (TREE_TYPE (tmp), "source"); - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))) + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) { gfc_allocate_lang_decl (var); - GFC_DECL_SAVED_DESCRIPTOR (var) = se.expr; + GFC_DECL_SAVED_DESCRIPTOR (var) = desc; } gfc_add_modify_loc (input_location, &block, var, tmp); @@ -5241,11 +5271,12 @@ expr3_len = se.string_length; } /* Store what the expr3 is to be used for. */ - e3_is = expr3 != NULL_TREE ? - (code->ext.alloc.arr_spec_from_expr3 ? - E3_DESC - : (code->expr3->mold ? E3_MOLD : E3_SOURCE)) - : E3_UNSET; + if (e3_is == E3_UNSET) + e3_is = expr3 != NULL_TREE ? + (code->ext.alloc.arr_spec_from_expr3 ? + E3_DESC + : (code->expr3->mold ? E3_MOLD : E3_SOURCE)) + : E3_UNSET; /* Figure how to get the _vtab entry. This also obtains the tree expression for accessing the _len component, because only @@ -5254,11 +5285,17 @@ if (code->expr3->ts.type == BT_CLASS) { gfc_expr *rhs; + tmp = expr3 != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (expr3)) ? + build_fold_indirect_ref (expr3): expr3; /* Polymorphic SOURCE: VPTR must be determined at run time. expr3 may be a temporary array declaration, therefore check for GFC_CLASS_TYPE_P before trying to get the _vptr component. */ - if (expr3 != NULL_TREE && GFC_CLASS_TYPE_P (TREE_TYPE (expr3)) - && (VAR_P (expr3) || !code->expr3->ref)) + if (tmp != NULL_TREE + && TREE_CODE (tmp) != POINTER_PLUS_EXPR + && (e3_is == E3_DESC + || (GFC_CLASS_TYPE_P (TREE_TYPE (tmp)) + && (VAR_P (tmp) || !code->expr3->ref)) + || (VAR_P (tmp) && DECL_LANG_SPECIFIC (tmp)))) tmp = gfc_class_vptr_get (expr3); else { @@ -5709,10 +5746,7 @@ /* Initialization via SOURCE block (or static default initializer). Classes need some special handling, so catch them first. */ if (expr3 != NULL_TREE - && ((POINTER_TYPE_P (TREE_TYPE (expr3)) - && TREE_CODE (expr3) != POINTER_PLUS_EXPR) - || (VAR_P (expr3) && GFC_CLASS_TYPE_P ( - TREE_TYPE (expr3)))) + && TREE_CODE (expr3) != POINTER_PLUS_EXPR && code->expr3->ts.type == BT_CLASS && (expr->ts.type == BT_CLASS || expr->ts.type == BT_DERIVED)) @@ -5731,7 +5765,7 @@ gfc_expr *ppc; gfc_code *ppc_code; gfc_ref *ref, *dataref; - gfc_expr *rhs = gfc_copy_expr (code->expr3); + gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3); /* Do a polymorphic deep copy. */ actual = gfc_get_actual_arglist (); @@ -5827,7 +5861,8 @@ void_type_node, tmp, extcopy, stdcopy); } gfc_free_statements (ppc_code); - gfc_free_expr (rhs); + if (rhs != e3rhs) + gfc_free_expr (rhs); } else { Index: gcc/testsuite/gfortran.dg/class_array_15.f03 =================================================================== --- gcc/testsuite/gfortran.dg/class_array_15.f03 (Revision 229293) +++ gcc/testsuite/gfortran.dg/class_array_15.f03 (Arbeitskopie) @@ -115,4 +115,4 @@ bh => bhGet(b,instance=2) if (loc (b) .ne. loc(bh%hostNode)) call abort end -! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } } +! { dg-final { scan-tree-dump-times "builtin_free" 11 "original" } } Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 229293) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,13 @@ +2015-10-25 Andre Vehreschild + + PR fortran/66927 + PR fortran/67044 + * gfortran.dg/allocate_with_source_10.f08: New test. + * gfortran.dg/allocate_with_source_11.f08: New test. + * gfortran.dg/class_array_15.f03: Changed count of expected + _builtin_frees to 11. One step of temporaries is spared, therefore + the allocatable component of that temporary is not to be freeed. + 2015-10-24 Steven G. Kargl PR fortran/68055