From patchwork Thu Apr 21 21:14:47 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 53101 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C03DC385625B for ; Thu, 21 Apr 2022 21:15:13 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from smtp.smtpout.orange.fr (smtp09.smtpout.orange.fr [80.12.242.131]) by sourceware.org (Postfix) with ESMTPS id 20D9A3858D37 for ; Thu, 21 Apr 2022 21:14:56 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 20D9A3858D37 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=orange.fr Authentication-Results: sourceware.org; spf=none smtp.mailfrom=orange.fr Received: from [192.168.1.17] ([86.253.179.215]) by smtp.orange.fr with ESMTPA id he8VnmmF5KpuHhe8bnyCXf; Thu, 21 Apr 2022 23:14:54 +0200 X-ME-Helo: [192.168.1.17] X-ME-Auth: MDU4MTIxYWM4YWI0ZGE4ZTUwZWZmNTExZmI2ZWZlMThkM2ZhYiE5OWRkOGM= X-ME-Date: Thu, 21 Apr 2022 23:14:54 +0200 X-ME-IP: 86.253.179.215 Message-ID: <8541b594-57c9-f6aa-7164-3918abe67a8f@orange.fr> Date: Thu, 21 Apr 2022 23:14:47 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.8.0 From: Mikael Morin Subject: [PATCH] fortran: Detect duplicate unlimited polymorphic types [PR103662] To: gfortran , gcc-patches Content-Language: en-US X-Spam-Status: No, score=-9.2 required=5.0 tests=BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, KAM_DMARC_STATUS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_NONE, TXREP 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Hello, this is a fix for PR103662, a TBAA issue with unlimited polymorphic types. I attached a draft patch to the PR which was accumulating all unlimited polymorphic symbols to a single namespace, avoiding duplicate symbols and thus eliminating the problem. After reviewing the code more in detail, I was afraid that some symbols could still end up in the local namespace, and that the problem would remain for them after all. Despite not being able to generate a testcase where it happened, I decided to produce a patch based on Jakub’s analysis in the PR audit trail, as that way supports duplicates by design. On top of Jakub’s patch, there are a couple more types registrations just in case (they handle duplicates so that’s fine), and the type comparison fix that he was too fortran-uncomfortable to do. The testcase had to be fixed as we found out in the PR audit trail. Regression tested on x86_64-pc-linux-gnu. OK for master? Mikael From ff9de8b00e5eedf44af0ce75d268dce216bf645f Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Wed, 20 Apr 2022 12:04:38 +0200 Subject: [PATCH] fortran: Detect duplicate unlimited polymorphic types [PR103662] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fixes a type-based alias analysis issue with unlimited polymorphic class descriptors (types behind class(*)) causing data initialisation to be removed by optimization. The fortran front-end may create multiple declarations for types, for example if a type is redeclared in each program unit it is used in. To avoid optimization seeing them as non-aliasing, a list of derived types is created at resolution time, and used at translation to set the same TYPE_CANONICAL type for each duplicate type declaration. This mechanism didn’t work for unlimited polymorphic descriptors types, as there is a short-circuit return skipping all the resolution handling for them, including the type registration. This change adds type registration (which handles duplicate registering) at several short-circuit returns, and updates type comparison to handle specifically unlimited polymorphic fake symbols, class descriptor types and virtual table types. The test, which exhibited mismatching dynamic types had to be fixed as well. PR fortran/103662 gcc/fortran/ChangeLog: * interface.cc (gfc_compare_derived_types): Support comparing unlimited polymorphic fake symbols. Recursively compare class descriptor types and virtual table types. * resolve.cc (resolve_fl_derived): Add type to the types list on unlimited polymorphic short-circuit return. (resolve_symbol): Ditto. gcc/testsuite/ChangeLog: * gfortran.dg/unlimited_polymorphic_3.f03 (foo): Separate bind(c) and sequence checks to... (foo_bc, foo_sq): ... two different procedures. (main, foo*): Change type declarations so that type name, component name, and either bind(c) or sequence attribute match between the main type declarations and the procedure type declarations. (toplevel): Add optimization dump checks. Co-Authored-By: Jakub Jelinek --- gcc/fortran/interface.cc | 19 +++++-- gcc/fortran/resolve.cc | 15 ++++- .../gfortran.dg/unlimited_polymorphic_3.f03 | 56 +++++++++++++------ 3 files changed, 66 insertions(+), 24 deletions(-) diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 000a530cba4..7ed6e13711f 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -618,6 +618,14 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) if (!derived1 || !derived2) gfc_internal_error ("gfc_compare_derived_types: invalid derived type"); + if (derived1->attr.unlimited_polymorphic + && derived2->attr.unlimited_polymorphic) + return true; + + if (derived1->attr.unlimited_polymorphic + != derived2->attr.unlimited_polymorphic) + return false; + /* Compare UNION types specially. */ if (derived1->attr.flavor == FL_UNION || derived2->attr.flavor == FL_UNION) return compare_union_types (derived1, derived2); @@ -630,10 +638,11 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) && strcmp (derived1->module, derived2->module) == 0) return true; - /* Compare type via the rules of the standard. Both types must have - the SEQUENCE or BIND(C) attribute to be equal. STRUCTUREs are special - because they can be anonymous; therefore two structures with different - names may be equal. */ + /* Compare type via the rules of the standard. Both types must have the + SEQUENCE or BIND(C) attribute to be equal. We also compare types + recursively if they are class descriptors types or virtual tables types. + STRUCTUREs are special because they can be anonymous; therefore two + structures with different names may be equal. */ /* Compare names, but not for anonymous types such as UNION or MAP. */ if (!is_anonymous_dt (derived1) && !is_anonymous_dt (derived2) @@ -646,6 +655,8 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) if (!(derived1->attr.sequence && derived2->attr.sequence) && !(derived1->attr.is_bind_c && derived2->attr.is_bind_c) + && !(derived1->attr.is_class && derived2->attr.is_class) + && !(derived1->attr.vtype && derived2->attr.vtype) && !(derived1->attr.pdt_type && derived2->attr.pdt_type)) return false; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 21c8797c938..011fb5eb14d 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -15112,7 +15112,10 @@ resolve_fl_derived (gfc_symbol *sym) gfc_symbol *gen_dt = NULL; if (sym->attr.unlimited_polymorphic) - return true; + { + add_dt_to_dt_list (sym); + return true; + } if (!sym->attr.is_class) gfc_find_symbol (sym->name, sym->ns, 0, &gen_dt); @@ -15150,7 +15153,10 @@ resolve_fl_derived (gfc_symbol *sym) /* Nothing more to do for unlimited polymorphic entities. */ if (data->ts.u.derived->attr.unlimited_polymorphic) - return true; + { + add_dt_to_dt_list (sym); + return true; + } else if (vptr->ts.u.derived == NULL) { gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived); @@ -15467,7 +15473,10 @@ resolve_symbol (gfc_symbol *sym) return; if (sym->attr.unlimited_polymorphic) - return; + { + add_dt_to_dt_list (sym); + return; + } if (sym->attr.flavor == FL_UNKNOWN || (sym->attr.flavor == FL_PROCEDURE && !sym->attr.intrinsic diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 index 075d6d727e2..780d68cdd87 100644 --- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 @@ -1,4 +1,5 @@ ! { dg-do run } +! { dg-additional-options "-fdump-tree-dse-details" } ! ! Check that pointer assignments allowed by F2003:C717 ! work and check null initialization of CLASS(*) pointers. @@ -7,20 +8,31 @@ ! program main interface - subroutine foo(z) + subroutine foo_bc(z) class(*), pointer, intent(in) :: z - end subroutine foo + end subroutine foo_bc + subroutine foo_sq(z) + class(*), pointer, intent(in) :: z + end subroutine foo_sq end interface + type, bind(c) :: bc + integer :: i + end type bc type sq sequence - integer :: i + integer :: k end type sq + type(bc), target :: w type(sq), target :: x class(*), pointer :: y, z - x%i = 42 + w%i = 23 + y => w + z => y ! unlimited => unlimited allowed + call foo_bc(z) + x%k = 42 y => x z => y ! unlimited => unlimited allowed - call foo (z) + call foo_sq(z) call bar contains subroutine bar @@ -33,21 +45,31 @@ contains end program main - -subroutine foo(tgt) +subroutine foo_bc(tgt) use iso_c_binding class(*), pointer, intent(in) :: tgt - type, bind(c) :: s - integer (c_int) :: k - end type s - type t + type, bind(c) :: bc + integer (c_int) :: i + end type bc + type(bc), pointer :: ptr1 + ptr1 => tgt ! bind(c) => unlimited allowed + if (ptr1%i .ne. 23) STOP 2 +end subroutine foo_bc + +subroutine foo_sq(tgt) + class(*), pointer, intent(in) :: tgt + type sq sequence integer :: k - end type t - type(s), pointer :: ptr1 - type(t), pointer :: ptr2 - ptr1 => tgt ! bind(c) => unlimited allowed - if (ptr1%k .ne. 42) STOP 2 + end type sq + type(sq), pointer :: ptr2 ptr2 => tgt ! sequence type => unlimited allowed if (ptr2%k .ne. 42) STOP 3 -end subroutine foo +end subroutine foo_sq + +! PR fortran/103662 +! We used to produce multiple independant types for the unlimited polymorphic +! descriptors (types for class(*)) which caused stores to them to be seen as +! useless. +! { dg-final { scan-tree-dump-not "Deleted dead store: z._data = &w" "dse1" } } +! { dg-final { scan-tree-dump-not "Deleted dead store: z._data = &x" "dse1" } } -- 2.35.1