From patchwork Sat Aug 25 20:01:54 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 179985 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 CBE2F2C00D3 for ; Sun, 26 Aug 2012 06:04:50 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1346529892; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject: References:In-Reply-To:Content-Type:Mailing-List:Precedence: List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender: Delivered-To; bh=f7a/YaZUCTDMTTqJJKAYc4IkDDk=; b=IUlDJIEPAqm9uY7 AUR+IzlsSwAI/PedlxXQGgOfLBxY7/eO5D4z5bL1Jb/0Yrpg0aKUvqLCbD9rfJoy rAwYb5ZTAMiv1SAU6g9lc5ss2am+LIQLzY4m4r29JQVxJqj23Zae160Lk5WlEtp7 stoqgAOyvvK0Zrp87xfD/ek8HAjs= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:X-SFR-UUID:Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject:References:In-Reply-To:Content-Type:X-IsSubscribed:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=F06VHrwZlnyZSrj9MCED4oQigIsVbDpd3GgCilCOctUBvwbHsdfciM5JqOU5NR D4hBEirvA4oaol27hYzrBkkfm26ru8y3egbMyyFdM9ZNdNVAEOPei1MBzqbPjsgI ndJZB5tgVgnCTAGsaLw+y28inueGJhx1jgFIikFJ+f3y4=; Received: (qmail 31182 invoked by alias); 25 Aug 2012 20:04:43 -0000 Received: (qmail 31165 invoked by uid 22791); 25 Aug 2012 20:04:41 -0000 X-SWARE-Spam-Status: No, hits=-2.4 required=5.0 tests=AWL, BAYES_00, KHOP_THREADED, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD, TW_TM X-Spam-Check-By: sourceware.org Received: from smtp23.services.sfr.fr (HELO smtp23.services.sfr.fr) (93.17.128.22) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 25 Aug 2012 20:04:15 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2317.sfr.fr (SMTP Server) with ESMTP id 87B9870000BC; Sat, 25 Aug 2012 22:04:14 +0200 (CEST) Received: from [192.168.1.58] (37.15.72.86.rev.sfr.net [86.72.15.37]) by msfrf2317.sfr.fr (SMTP Server) with ESMTP id 1D40170000B7; Sat, 25 Aug 2012 22:04:14 +0200 (CEST) X-SFR-UUID: 20120825200414119.1D40170000B7@msfrf2317.sfr.fr Message-ID: <50392F32.3080907@sfr.fr> Date: Sat, 25 Aug 2012 22:01:54 +0200 From: Mikael Morin User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:10.0.6esrpre) Gecko/20120811 Thunderbird/10.0.6 MIME-Version: 1.0 To: Dominique Dhumieres CC: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: Re: [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell References: <20120825180043.C73E73BE1A@mailhost.lps.ens.fr> In-Reply-To: <20120825180043.C73E73BE1A@mailhost.lps.ens.fr> X-IsSubscribed: yes 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 On 25/08/2012 20:00, Dominique Dhumieres wrote: > Dear Mikael, > > Your set of patches works as defined, i.e., it fixes pr45586 without > regression on the test suite. However, If the test suite is run with > -flto, there are still some failures depending on the way gcc is > configured. Thanks for testing. All right, I'll have to master the LTO beast too. In the meantime is it by any chance better if the first patch in the serie is replaced by the attached one? Mikael diff --git a/trans-expr.c b/trans-expr.c index ebaa238..37dfb5a 100644 --- a/trans-expr.c +++ b/trans-expr.c @@ -6306,6 +6332,127 @@ gfc_conv_string_parameter (gfc_se * se) } +static void +whole_struct_copy (gfc_se *lse, gfc_se *rse, gfc_typespec ts, + stmtblock_t *block) +{ + gfc_ref ref; + gfc_component *comp; + tree old_lhs, old_rhs, tmp; + gfc_symbol *derived; + +#if 0 + if ((ts.type != BT_CLASS && ts.type != BT_DERIVED) + || !ts.u.derived->attr.alloc_comp) + { + gfc_add_modify (block, lse->expr, + fold_convert (TREE_TYPE (lse->expr), rse->expr)); + return; + } +#endif + + derived = ts.u.derived; + old_lhs = lse->expr; + old_rhs = gfc_evaluate_now (rse->expr, block); + + ref.type = REF_COMPONENT; + ref.next = NULL; + ref.u.c.sym = derived; + for (comp = derived->components; comp; comp = comp->next) + { + ref.u.c.component = comp; + gfc_conv_component_ref (lse, &ref); + gfc_conv_component_ref (rse, &ref); + if ((comp->attr.pointer + && !comp->attr.dimension + && !comp->attr.codimension) + || comp->attr.proc_pointer) + { + /* Undereference pointers. */ + if (TREE_CODE (lse->expr) == INDIRECT_REF) + lse->expr = TREE_OPERAND (lse->expr, 0); + if (TREE_CODE (rse->expr) == INDIRECT_REF) + rse->expr = TREE_OPERAND (rse->expr, 0); + gfc_add_modify (block, lse->expr, rse->expr); + } + + else if (!comp->attr.allocatable || !comp->attr.dimension) + { + bool deep_copy; + + if (comp->attr.dimension) + { + lse->expr = build4_loc (input_location, ARRAY_RANGE_REF, + TREE_TYPE (lse->expr), lse->expr, + gfc_index_zero_node, NULL_TREE, + NULL_TREE); + rse->expr = build4_loc (input_location, ARRAY_RANGE_REF, + TREE_TYPE (rse->expr), rse->expr, + gfc_index_zero_node, NULL_TREE, + NULL_TREE); + /* Disable subreferences after the array range. */ + deep_copy = false; + } + else + deep_copy = true; + + tmp = gfc_trans_scalar_assign (lse, rse, comp->ts, true, deep_copy, false); + gfc_add_expr_to_block (block, tmp); + } + else + { + tree l_base_expr, r_base_expr; + tree l_field, r_field; + + l_base_expr = lse->expr; + r_base_expr = rse->expr; + gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (l_base_expr)) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (r_base_expr))); + /* copy all but the data pointer in the descriptor. */ + for (l_field = TYPE_FIELDS (TREE_TYPE (l_base_expr)), + r_field = TYPE_FIELDS (TREE_TYPE (r_base_expr)); + l_field != NULL_TREE && r_field != NULL_TREE; + l_field = DECL_CHAIN (l_field), + r_field = DECL_CHAIN (r_field)) + { + gcc_assert (TREE_CODE (l_field) == FIELD_DECL + && TREE_CODE (r_field) == FIELD_DECL + && DECL_NAME (l_field) == DECL_NAME (r_field)); + if (strcmp (IDENTIFIER_POINTER (DECL_NAME (l_field)), + "data") == 0) + continue; + + lse->expr = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (l_field), + l_base_expr, + l_field, NULL_TREE); + rse->expr = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (r_field), r_base_expr, + r_field, NULL_TREE); + if (TREE_CODE (TREE_TYPE (lse->expr)) == ARRAY_TYPE) + { + gcc_assert (TREE_CODE (TREE_TYPE (rse->expr)) == ARRAY_TYPE); + lse->expr = build4_loc (input_location, ARRAY_RANGE_REF, + TREE_TYPE (lse->expr), + lse->expr, gfc_index_zero_node, + NULL_TREE, NULL_TREE); + rse->expr = build4_loc (input_location, ARRAY_RANGE_REF, + TREE_TYPE (rse->expr), + rse->expr, gfc_index_zero_node, + NULL_TREE, NULL_TREE); + + + } + gfc_add_modify (block, lse->expr, rse->expr); + } + } + + lse->expr = old_lhs; + rse->expr = old_rhs; + } +} + + /* Generate code for assignment of scalar variables. Includes character strings and derived types with allocatable components. If you know that the LHS has no allocations, set dealloc to false. @@ -6396,8 +6543,30 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, gfc_add_block_to_block (&block, &rse->pre); gfc_add_block_to_block (&block, &lse->pre); - gfc_add_modify (&block, lse->expr, - fold_convert (TREE_TYPE (lse->expr), rse->expr)); + if (deep_copy) + whole_struct_copy (lse, rse, ts, &block); + else + { + tree converted; + + if (TYPE_MAIN_VARIANT (TREE_TYPE (lse->expr)) + != TYPE_MAIN_VARIANT (TREE_TYPE (rse->expr)) + && !POINTER_TYPE_P (TREE_TYPE (lse->expr)) + && !POINTER_TYPE_P (TREE_TYPE (rse->expr))) + { + gcc_assert (TYPE_CANONICAL (TREE_TYPE (lse->expr)) + == TYPE_CANONICAL (TREE_TYPE (rse->expr)) + && gfc_nonrestricted_type (TREE_TYPE (lse->expr)) + == gfc_nonrestricted_type (TREE_TYPE (rse->expr))); + /* fold_convert won't like this. Let's bypass it. */ + converted = fold_build1_loc (input_location, VIEW_CONVERT_EXPR, + TREE_TYPE (lse->expr), rse->expr); + } + else + converted = fold_convert (TREE_TYPE (lse->expr), rse->expr); + + gfc_add_modify (&block, lse->expr, converted); + } /* Do a deep copy if the rhs is a variable, if it is not the same as the lhs. */