From patchwork Mon Mar 7 14:01:59 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1602192 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by bilbo.ozlabs.org (Postfix) with ESMTPS id 4KC0XL28pnz9sFr for ; Tue, 8 Mar 2022 01:02:42 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7DC683858021 for ; Mon, 7 Mar 2022 14:02:39 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id 40E1E3858D35; Mon, 7 Mar 2022 14:02:23 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 40E1E3858D35 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.90,162,1643702400"; d="diff'?scan'208";a="72790860" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 07 Mar 2022 06:02:10 -0800 IronPort-SDR: UHXbTK96vNNewWyxE6aYnETxJ7HjSRho2VZaFtHYqxkQqebAhtuc8HYVUzhM8LpETxMVcBQj4Y B5o48MBskf9/9mlV7cvoih5OR01JtofdGwVo4tFEEzRpI8tMP7/arB8ajXOEsxE49MwMamhl5j 5rVIhavLtDlSblc8BaQcdtMmIt3o0rUHXwYcWkh3OJh5vX5otJJWp0i3FCURHxsCADafjL61xz tlJwsSmAesnNwQnmS0e4nRnIG8s5rCZrdfcHcwUIgoZREVHzy/GtbcGn2Ru6hxSQJTxdbYAmJC x2k= Message-ID: <2cd2f3b9-3b67-dc5f-de37-94c9c5002e53@codesourcery.com> Date: Mon, 7 Mar 2022 15:01:59 +0100 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.6.2 Content-Language: en-US To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch] Fortran: Fix gfc_maybe_dereference_var [PR104430] X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: SVR-IES-MBX-07.mgc.mentorg.com (139.181.222.7) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" The problem is that inside the main program, y = f(z) where the the result of z is type(t) :: z(size(x%a)) and 'x' is a dummy argument. 'x' looses the attr.dummy in gfc_add_interface_mapping and this leads to an additional indirect ref in gfc_maybe_dereference_var - but after the first indirect ref, TREE_TYPE is alread a RECORD_TYPE ... The simple fix is to simply punt when the argument is not a pointer or reference. This patch additionally fixes a comment in conv_parent_component_references. Those parts are obvious. The only potentially risky change is the comparison change from a name-wise comparison to a pointer-based comparison. I think it is fine and the testsuite did not find any issue, but you prefer, I can also exclude it. OK for mainline? How about GCC 10/11 backports? (I think leaving out the last change, it should be very safe to do.) Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 Fortran: Fix gfc_maybe_dereference_var [PR104430] PR fortran/104430 gcc/fortran/ChangeLog: * trans-expr.cc (conv_parent_component_references): Fix comment; simplify comparison. (gfc_maybe_dereference_var): Avoid derefereing a nonpointer gcc/testsuite/ChangeLog: * gfortran.dg/class_result_10.f90: New test. gcc/fortran/trans-expr.cc | 6 ++++-- gcc/testsuite/gfortran.dg/class_result_10.f90 | 25 +++++++++++++++++++++++++ 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index eb6a78c3a62..e441952818b 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -2805,9 +2805,9 @@ conv_parent_component_references (gfc_se * se, gfc_ref * ref) dt = ref->u.c.sym; c = ref->u.c.component; - /* Return if the component is in the parent type. */ + /* Return if the component is in this type, i.e. not in the parent type. */ for (cmp = dt->components; cmp; cmp = cmp->next) - if (strcmp (c->name, cmp->name) == 0) + if (c == cmp) return; /* Build a gfc_ref to recursively call gfc_conv_component_ref. */ @@ -2867,6 +2867,8 @@ tree gfc_maybe_dereference_var (gfc_symbol *sym, tree var, bool descriptor_only_p, bool is_classarray) { + if (!POINTER_TYPE_P (TREE_TYPE (var))) + return var; if (is_CFI_desc (sym, NULL)) return build_fold_indirect_ref_loc (input_location, var); diff --git a/gcc/testsuite/gfortran.dg/class_result_10.f90 b/gcc/testsuite/gfortran.dg/class_result_10.f90 new file mode 100644 index 00000000000..acd9a73ebda --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_result_10.f90 @@ -0,0 +1,25 @@ +! { dg-do run} +! +! PR fortran/104430 +! +! Contributed by G. Steinmetz + +module m + type t + integer :: a + end type +contains + function f(x) result(z) + class(t) :: x(:) + type(t) :: z(size(x%a)) + z%a = 42 + end +end +program p + use m + class(t), allocatable :: y(:), z(:) + allocate (y(32)) + z = f(y) + if (size(z) /= 32) stop 1 + if (any (z%a /= 42)) stop 2 +end