From patchwork Sun Jun 7 14:40:45 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Thomas_K=C3=B6nig?= X-Patchwork-Id: 1304725 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=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=tkoenig.net Authentication-Results: ozlabs.org; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=tkoenig.net header.i=@tkoenig.net header.a=rsa-sha256 header.s=strato-dkim-0002 header.b=W+VPu44l; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (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 ozlabs.org (Postfix) with ESMTPS id 49fzZt0SPcz9sRR for ; Mon, 8 Jun 2020 00:40:54 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 648A33870868; Sun, 7 Jun 2020 14:40:50 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mo4-p00-ob.smtp.rzone.de (mo4-p00-ob.smtp.rzone.de [81.169.146.163]) by sourceware.org (Postfix) with ESMTPS id 7DCE53851C34; Sun, 7 Jun 2020 14:40:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 7DCE53851C34 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=tkoenig.net Authentication-Results: sourceware.org; spf=none smtp.mailfrom=tk@tkoenig.net DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; t=1591540846; s=strato-dkim-0002; d=tkoenig.net; h=Date:Message-ID:Subject:From:To:X-RZG-CLASS-ID:X-RZG-AUTH:From: Subject:Sender; bh=KDqiwKsfVZLxWFhZgRUVbA7Y0R/hD6iMtFUzXHU5skQ=; b=W+VPu44l+jDC932nvNa0uUxA1GiNXNO8e8CcvoqTHFJSrJ+AtHswU5H8Hr9nC8m/RU U0F9hx5iuuBVrwluAQDY6oapaZig1Eois3NpvoFTzT9uQwHZPoHUSg4jKS2vnAbz1m9A uHqQFRqQiIInK9/9ZJCYgrkph3M+smjeg8KB0d5n1TIFJvlHnL86HDtOSMn23VpELRv2 KKriImw1fo+T9vA9+uROeOJoxQ4cjyCe+wP8Nd9q+nd+VyqYe5Do2NsSriuW2veXjdHp qMYeuA8DZM8PPRx0o0RwF8AEYvgkDYwDYW0AmOy8GaPaU2Y+GT43lKjP98yg7/xu3V4H UndQ== X-RZG-AUTH: ":OGckYUunfvGNVUL0FlRnC4eRM+bOwx0tUtYTrJ/xeZX+ZVNns7qeI3kOmGi2VoYivFr3B8yTQn1LPS7pIiQ935gtmYHPXNc=" X-RZG-CLASS-ID: mo00 Received: from linux-p51k.fritz.box by smtp.strato.de (RZmta 46.9.1 AUTH) with ESMTPSA id n0a616w57EejGeV (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256 bits)) (Client did not present a certificate); Sun, 7 Jun 2020 16:40:45 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches From: =?utf-8?q?Thomas_K=C3=B6nig?= Subject: [patch, fortran] Fix memory leak on deallocation Message-ID: <045e6de8-2720-54d4-2e3e-9f9d88f257b4@tkoenig.net> Date: Sun, 7 Jun 2020 16:40:45 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.8.0 MIME-Version: 1.0 Content-Language: de-DE X-Spam-Status: No, score=-12.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_PASS, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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@gcc.gnu.org Sender: "Gcc-patches" Hello world, Our finalization handling is a mess. Really, we should get to try and get this fixed for gcc 11. In the meantime, here is a patch which fixes a regression I introduced when fixing a regression with a memory leak. The important thing here is to realize that we do not need to finalize (and deallocate) multiple times for the same expression and the same component in the same namespace. It might cause code size regressions, but better big code than wrong code... This is a regression all the way down to gcc 8. OK for all affected branches? Regards Thomas gcc/fortran/ChangeLog: PR fortran/94109 * class.c (finalize_component): Return early if finalization has already happened for expression and component within namespace. * gfortran.h (gfc_was_finalized): New type. (gfc_namespace): Add member was_finalzed. (gfc_expr): Remove finalized. * symbol.c (gfc_free_namespace): Free was_finalized. gcc/testsuite/ChangeLog: PR fortran/94109 * gfortran.dg/finalize_34.f90: Adjust free counts. * gfortran.dg/finalize_36.f90: New test. diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 9aa3eb7282c..b5a1edae27f 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -911,7 +911,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, if (!comp_is_finalizable (comp)) return; - if (comp->finalized) + if (expr->finalized) return; e = gfc_copy_expr (expr); @@ -1002,6 +1002,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, } else (*code) = cond; + } else if (comp->ts.type == BT_DERIVED && comp->ts.u.derived->f2k_derived @@ -1041,7 +1042,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, sub_ns); gfc_free_expr (e); } - comp->finalized = true; + expr->finalized = 1; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 7094791e871..5af44847f9b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1107,7 +1107,6 @@ typedef struct gfc_component struct gfc_typebound_proc *tb; /* When allocatable/pointer and in a coarray the associated token. */ tree caf_token; - bool finalized; } gfc_component; @@ -2218,6 +2217,9 @@ typedef struct gfc_expr /* Set this if the expression came from expanding an array constructor. */ unsigned int from_constructor : 1; + /* Set this if the expression has already been finalized. */ + unsigned int finalized : 1; + /* If an expression comes from a Hollerith constant or compile-time evaluation of a transfer statement, it may have a prescribed target- memory representation, and these cannot always be backformed from diff --git a/gcc/testsuite/gfortran.dg/finalize_28.f90 b/gcc/testsuite/gfortran.dg/finalize_28.f90 index 597413b2dd3..f0c9665252f 100644 --- a/gcc/testsuite/gfortran.dg/finalize_28.f90 +++ b/gcc/testsuite/gfortran.dg/finalize_28.f90 @@ -21,4 +21,4 @@ contains integer, intent(out) :: edges(:,:) end subroutine coo_dump_edges end module coo_graphs -! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 6 "original" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_33.f90 b/gcc/testsuite/gfortran.dg/finalize_33.f90 index 2205f9eed7f..3857e4485ee 100644 --- a/gcc/testsuite/gfortran.dg/finalize_33.f90 +++ b/gcc/testsuite/gfortran.dg/finalize_33.f90 @@ -116,4 +116,4 @@ contains ! (iii) mci_template end program main_ut ! { dg-final { scan-tree-dump-times "__builtin_malloc" 17 "original" } } -! { dg-final { scan-tree-dump-times "__builtin_free" 19 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 20 "original" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_34.f90 b/gcc/testsuite/gfortran.dg/finalize_34.f90 index e2f02a5c51c..fef7dac6d89 100644 --- a/gcc/testsuite/gfortran.dg/finalize_34.f90 +++ b/gcc/testsuite/gfortran.dg/finalize_34.f90 @@ -22,4 +22,4 @@ program main use testmodule type(evtlist_type), dimension(10) :: a end program main -! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 12 "original" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_35.f90 b/gcc/testsuite/gfortran.dg/finalize_35.f90 new file mode 100644 index 00000000000..66435c43ecc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_35.f90 @@ -0,0 +1,48 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } +! PR 94361 - this left open some memory leaks. Original test case by +! Antony Lewis. + +module debug + private + + Type TypeWithFinal + contains + FINAL :: finalizer !No leak if this line is commented + end type TypeWithFinal + + Type Tester + real, dimension(:), allocatable :: Dat + Type(TypeWithFinal) :: X + end Type Tester + + Type :: TestType2 + Type(Tester) :: T + end type TestType2 + public Leaker +contains + + subroutine Leaker + type(TestType2) :: Test + + allocate(Test%T%Dat(1000)) + end subroutine Leaker + + subroutine finalizer(this) + Type(TypeWithFinal) :: this + end subroutine finalizer + +end module debug + + +program run + use debug + implicit none + integer i + + do i=1, 1000 + call Leaker() + end do + +end program run +! { dg-final { scan-tree-dump-times "__builtin_free\\ \\(ptr2" 2 "original" } }