From patchwork Mon Apr 25 13:47:19 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 53185 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 774C33857034 for ; Mon, 25 Apr 2022 13:48:46 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 270A03858430; Mon, 25 Apr 2022 13:47:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 270A03858430 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,288,1643702400"; d="diff'?scan'208";a="74929625" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 25 Apr 2022 05:47:25 -0800 IronPort-SDR: cI/cjIy3GCg0JZ68r0JdC0vOWQ1dK6wtsEjR57x859R2JNSAnTl44QVewv6xT9llB+Rwpc+5L1 LPGbGRnnlBYUM/Y4IYuMpnGKccdWZa9fKF0vSLxY1Y5cQjYlg7GvjZOycioAde1hFsw5+kAWG3 bE0N1/zp+s/j40pcBVXtuQeHK0zrxQObloJk2u9OdHSYIe21amKXkATiLrMlnF1RSPI85elhBe 9Wl6/HeXlj2cyoHoXaCN2t0bHu2MSXYbnd1z4mfcliCTZLGoTjefbrzzplDJe7mFMgDpg5tZNb qTY= Message-ID: Date: Mon, 25 Apr 2022 15:47:19 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.8.1 Subject: [OG11-committed][stage1-patch] Fortran: Fix finalization resolution with deep copy (was: [Patch][Stage 1] Fortran/OpenMP: Support mapping of DT with allocatable components) Content-Language: en-US From: Tobias Burnus To: gcc-patches , fortran , Jakub Jelinek References: In-Reply-To: X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-15.mgc.mentorg.com (139.181.222.15) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, 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" Found another issue – applied to OG11 as attached. Will include it in the mainline patch once Stage1. (However, I intent to split the original patch (+ follow ups) into smaller pieces for mainline incorporation.) Tobias On 02.03.22 23:20, Tobias Burnus wrote: > Some testing found an issue in class.cc (in the new _callback > function) – updated patch attached (long version + interdiff). > > Tobias > > (PS: OG11 - original patch was committed as > https://gcc.gnu.org/g:98961d3a0ccb02d7d54d2d4dd07cca75473d685a ; > follow-up version to be committed in a moment) > > On 01.03.22 16:34, Tobias Burnus wrote: >> Hi all, >> >> this patch adds support for mapping something like >> type t >> type(t2), allocatable :: a, b(:) >> integer, allocatable :: c, c(:) >> end type t >> type(t), allocatable :: var, var2(:,:) >> >> !$omp target enter data map(var, var) >> >> which does a deep walk of the components at runtime. >> >> On the ME side, the static addr/size/kinds arrays are >> replaced (only if need) by allocatable arrays – which >> are then filled by trans-openmp.c. >> >> All deep-mapping handling happens via the hooks called >> late in omp-low.c such that removing mappings or implicitly >> added one are handled. >> >> In principle, there is also code to handle polymorphic >> variables (new callback function in vtable + two on-the-fly >> generated functions to be used for walking the vtable). >> >> Issues: None known, but I am sure with experimenting, >> more can be found - especially with arrays/array sections >> and polymorphism, I expect issues. I did find some on the >> way and fixed them - but (see PR refs in testcase -7.f90), >> I also found unrelated bugs, which I did not fix ;-) >> >> Comments? OK for mainline (GCC 13)? >> >> Tobias >> >> PS: I will commit this patch to OG11 for further testing. >> PPS: Previously discussed at >> https://gcc.gnu.org/pipermail/gcc-patches/2021-December/586237.html ----------------- 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 commit c6daf2090d48bc794c6809a5d98e8d9a583346bd Author: Tobias Burnus Date: Mon Apr 25 15:12:01 2022 +0200 Fortran: Fix finalization resolution with deep copy Follow-up patch to "Fortran/OpenMP: Support mapping of DT with allocatable components" https://gcc.gnu.org/pipermail/gcc-patches/2022-March/591144.html gcc/fortran/ChangeLog: * resolve.c (gfc_resolve_finalizers): Also resolve allocatable comps. gcc/testsuite/ChangeLog: * gfortran.dg/finalize_38.f90: New test. --- gcc/fortran/resolve.c | 11 ++- gcc/testsuite/gfortran.dg/finalize_38.f90 | 135 ++++++++++++++++++++++++++++++ 2 files changed, 143 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 59faa4c119d..10c89de0eaa 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13578,11 +13578,16 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) if (parent) gfc_resolve_finalizers (parent, finalizable); - /* Ensure that derived-type components have a their finalizers resolved. */ + /* Ensure that derived-type components have a their finalizers resolved; + handle allocatables but avoid issues with (in)direct allocatable types. */ bool has_final = derived->f2k_derived && derived->f2k_derived->finalizers; for (c = derived->components; c; c = c->next) - if (c->ts.type == BT_DERIVED - && !c->attr.pointer && !c->attr.proc_pointer && !c->attr.allocatable) + if (c->ts.type == BT_DERIVED && !c->attr.pointer && !c->attr.proc_pointer + && (!c->attr.allocatable + || (c->ts.u.derived != derived + && c->ts.u.derived->f2k_derived + && c->ts.u.derived->f2k_derived->finalizers + && !c->ts.u.derived->f2k_derived->finalizers->proc_tree))) { bool has_final2 = false; if (!gfc_resolve_finalizers (c->ts.u.derived, &has_final2)) diff --git a/gcc/testsuite/gfortran.dg/finalize_38.f90 b/gcc/testsuite/gfortran.dg/finalize_38.f90 new file mode 100644 index 00000000000..442e1753311 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_38.f90 @@ -0,0 +1,135 @@ +! { dg-do compile } +! +! Check finalization +! +module Real_2D__Form + + implicit none + private + + integer, parameter :: & + KDR = kind ( 1.0d0 ), & + KDI = kind ( 1 ), & + KDL = kind ( .true. ) + + type, public :: Real_2D_Form + real ( KDR ), dimension ( :, : ), allocatable :: & + Value + contains + procedure, private, pass :: & + Initialize_R_2D + procedure, private, pass :: & + Initialize_R_2D_FromValue + procedure, private, pass :: & + Initialize_R_2D_Copy + generic :: & + Initialize & + => Initialize_R_2D, Initialize_R_2D_FromValue, Initialize_R_2D_Copy + final :: & + Finalize_R_2D + end type Real_2D_Form + + type, public :: Real_2D_2D_Form + type ( Real_2D_Form ), dimension ( :, : ), allocatable :: & + Value + contains + final :: & + Finalize_R_2D_2D + end type Real_2D_2D_Form + +contains + + subroutine Initialize_R_2D ( A, nValues, ClearOption, iaLowerBoundOption ) + class ( Real_2D_Form ), intent ( inout ) :: & + A + integer ( KDI ), dimension ( 2 ), intent ( in ) :: & + nValues + logical ( KDL ), intent ( in ), optional :: & + ClearOption + integer ( KDI ), dimension ( 2 ), intent ( in ), optional :: & + iaLowerBoundOption + + integer ( KDI ), dimension ( 2 ) :: & + iaLB + logical ( KDL ) :: & + ClearRequested + + if ( any ( nValues < 0 ) ) return + + if ( all ( nValues == 0 ) ) then + allocate ( A % Value ( 0, 0 ) ) + return + end if + + ClearRequested = .false. + if ( present ( ClearOption ) ) ClearRequested = ClearOption + + iaLB = 1 + if ( present ( iaLowerBoundOption ) ) iaLB = iaLowerBoundOption + + allocate & + ( A % Value & + ( iaLB ( 1 ) : iaLB ( 1 ) + nValues ( 1 ) - 1, & + iaLB ( 2 ) : iaLB ( 2 ) + nValues ( 2 ) - 1 ) ) + + !if ( ClearRequested ) call Clear ( A % Value ) + + end subroutine Initialize_R_2D + + + subroutine Initialize_R_2D_FromValue ( A, Value, iaLowerBoundOption ) + + class ( Real_2D_Form ), intent ( inout ) :: & + A + real ( KDR ), dimension ( :, : ), intent ( in ) :: & + Value + integer ( KDI ), dimension ( 2 ), intent ( in ), optional :: & + iaLowerBoundOption + + call A % Initialize_R_2D & + ( shape ( Value ), iaLowerBoundOption = iaLowerBoundOption ) + A % Value = Value + + end subroutine Initialize_R_2D_FromValue + + + subroutine Initialize_R_2D_Copy ( A, B, iaLowerBoundOption ) + + class ( Real_2D_Form ), intent ( inout ) :: & + A + type ( Real_2D_Form ), intent ( in ) :: & + B + integer ( KDI ), intent ( in ), optional :: & + iaLowerBoundOption + + integer ( KDI ), dimension ( 2 ) :: & + iaLB + + iaLB = lbound ( B % Value ) + if ( present ( iaLowerBoundOption ) ) iaLB = iaLowerBoundOption + + call A % Initialize_R_2D_FromValue ( B % Value, iaLowerBoundOption = iaLB ) + + end subroutine Initialize_R_2D_Copy + + + elemental subroutine Finalize_R_2D ( A ) + + type ( Real_2D_Form ), intent ( inout ) :: & + A + + if ( allocated ( A % Value ) ) deallocate ( A % Value ) + + end subroutine Finalize_R_2D + + + elemental subroutine Finalize_R_2D_2D ( A ) + + type ( Real_2D_2D_Form ), intent ( inout ) :: & + A + + if ( allocated ( A % Value ) ) deallocate ( A % Value ) + + end subroutine Finalize_R_2D_2D + +end module Real_2D__Form