From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.21]) by sourceware.org (Postfix) with ESMTPS id 403A7384DD25; Tue, 4 Jun 2024 10:24:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 403A7384DD25 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 403A7384DD25 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.17.21 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1717496695; cv=none; b=slDXB8mAm37pfgHlzhUSXpGOZV/L1HI0dRY5IOAE7ofcrgzz16GKaG7C0sWAxXeyQtP1UqpnMuxEMkapOG2P2GErTAIw0nW/rs68Dglq4r5fuPszqrC8+7GGvGdBwaCwePp3Nb+Dj7uHTJQDBdRpP6mX+Lh2k5BDzTg2KGHtHYA= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1717496695; c=relaxed/simple; bh=sivVI4O51G7MzlWJmuNUf0z5/Zxova1Sv2VkgpftCqM=; h=DKIM-Signature:Date:From:To:Subject:Message-ID:MIME-Version; b=juZeGkHra1dt+HZurHZZ0ZQtg933Tja6KZRROnANVxTlmCYaxsUDEy0C7lzs7cNr4+h9iT+8BGWg/7i5Wjym7hko67FBwsnkYSNVJOxJbhupJo8v2d1o4Dhyk837m84u7qhMZ7WQni+y+A0qxCvK20QbPo/zavNyQmvkahFQvWs= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmx.de; s=s31663417; t=1717496690; x=1718101490; i=vehre@gmx.de; bh=iXmpGsu6M+31Rv1VBHmiDwjAAyFY9uKkqISSuX6YCzQ=; h=X-UI-Sender-Class:Date:From:To:Subject:Message-ID:MIME-Version: Content-Type:cc:content-transfer-encoding:content-type:date:from: message-id:mime-version:reply-to:subject:to; b=Qq5UeReZYfBoFxvu1X4AcZIRYLQoW5/ZleERmL6Elamu1eTwIK2/e4YymFVe41Nk SCmA/we4u5m0nhS/l/9uPJGU/WKlmOJN+DJT9cgPgYeyI0nu8uzG9zvf8oyS27dhB rcN/B78+VE8o26F/OE8S2DFzP+/0MfflCcTrKARLM32CQR75PD1XSWEzTda5tr39w zf/L1W+48NZYQ0JRX3vUPxrutsnKObszKQf/cQggsbG5tXrEr8oclfEfsOMBTu9Pr q/uSdQH8f25v+w1lOy3yPkJcGSZPT3BxKqJk0GSp4wInpFaxUD07Sf4aIx66/PF0j abCZc6TC1+MExu9OPA== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from vepi2 ([79.194.171.229]) by mail.gmx.net (mrgmx104 [212.227.17.168]) with ESMTPSA (Nemesis) id 1M42jQ-1sERLW0bpI-003cos; Tue, 04 Jun 2024 12:24:50 +0200 Date: Tue, 4 Jun 2024 12:24:49 +0200 From: Andre Vehreschild To: GCC-Fortran-ML , GCC-Patches-ML , everythingfunctional@protonmail.com Subject: [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak Message-ID: <20240604122449.2b514925@vepi2> X-Mailer: Claws Mail 4.2.0 (GTK 3.24.41; x86_64-redhat-linux-gnu) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/ZZLKtxLnT2_Iyb3MxBFwk1V" X-Provags-ID: V03:K1:pvFzwhcsvPd1LOo5yH3zD28wDzv0DNakDVGV1IE7wPm+lDXxNc2 0mhizRkYFYy9EB0cFYbK0cszu2njvab97hxqk/EtDcK1MHk7kHdXAxd6Uigdw+Hs/71veZO M73PByk3tuk2dkSBmsMBQDgyiqk5AHAtTuMdO098gAQgkVuiAHFkrgPMzUdiZgCXI9NaU4J RxRL9awI9ItB11GU4FZTQ== UI-OutboundReport: notjunk:1;M01:P0:x/L4ujiaeyo=;4a/yfG+dbp+mXTb7TR049O0KTuy MHznTA3WqyTv5T6eLk337/sEmrvQOTQUY/I9J0A+FQx2frD9FyOz4KaLDc0svP0a1NzSsGuV4 y7jXVt3H/ao6r4PkJDQa4Jh9DUvjye2Z8VnExqbh/p60AdOAqk1kyl81AVMquK/WKzbaMue1u 4f6OpHTqWSR8OJekACHefjADO4mO7Rwo8uJLMjDDOvxFrFMLRHIcPRqK8myzfQJV6MOVNVBKE sIrd0OnUSE2Qmufm2ByLcyrjrbAz3Ec6f6as4Nd15V9hCwFZwExx6M7Cos3v+oT/NQcuqJyfe pQyMPuUKqt2E9SggJM8HGWghWEpIUOCLz92WS/NMV2Uhy8DuHeiT5O18/QRJsmGD8ri75Q8f4 i5t31AZF7AIpcHcsqr3MSNy70k0V4v9EyC3wpQXAsk/MOuy6DHDenOzSWTkahzTgyQm24Hn3Y 0KG4sEx3SqW2FcdYFoAudgeqwm691FkloMC54pK53Mpvjj9TKIg9LOW1A6TBMU2yOz3R4Ht6G bwyOB/oz4six8m2+nFw162/tgBtUe0lsBQhIlqxuwnBbUPo06T2PR58bnaqSPNviEzSK7P0se BVWYWO6F0wjxiCn97klQLvJaDlQl6leqsoKKfjfIysFvYkXBrPSiZTu7APNhke7Tu/6e/zIwt LwfEJ1I5WEHmQdKWCDSrOwkVnCpWOxXKi/y84TLXha5SM5dzjy32DAir7K2i16yZ9dFwDGVCI kgKLc+oic45MZlqI5Emu+18sI50RB0vYSkatJL7rdzrZYM5inXGE2hdnOohDwRC/4+2fC4jvl N9gz5mbc1R6BWeBwbRdFSWfG33GVylLNJd5/rv1X9W3xU= X-Spam-Status: No, score=-10.3 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,RCVD_IN_DNSWL_LOW,RCVD_IN_MSPIKE_H2,SPF_HELO_NONE,SPF_PASS,TXREP,T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: --MP_/ZZLKtxLnT2_Iyb3MxBFwk1V Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Hi all, attached patch fixes a memory leak when a user-defined function returns a polymorphic type/class. The issue was, that the polymorphic type was not detected correctly and therefore the len-field was not transferred correct= ly. Regtests ok x86_64-linux/Fedora 39. Ok for master? Regards, Andre =2D- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/ZZLKtxLnT2_Iyb3MxBFwk1V Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=pr90072_1.patch =46rom e79072de7279cc6863914588e4a0457f0c3493fd Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Wed, 19 Jul 2023 11:57:43 +0200 Subject: [PATCH] Fix returned type to be allocatable for user-functions. The returned type of user-defined function returning a class object was not detected and handled correctly, which lead to memory leaks. PR fortran/90072 gcc/fortran/ChangeLog: * expr.cc (gfc_is_alloc_class_scalar_function): Detect allocatable class return types also for user-defined functions. * trans-expr.cc (gfc_conv_procedure_call): Same. (trans_class_vptr_len_assignment): Compute vptr len assignment correctly for user-defined functions. gcc/testsuite/ChangeLog: * gfortran.dg/class_77.f90: New test. =2D-- gcc/fortran/expr.cc | 13 ++-- gcc/fortran/trans-expr.cc | 35 +++++------ gcc/testsuite/gfortran.dg/class_77.f90 | 83 ++++++++++++++++++++++++++ 3 files changed, 109 insertions(+), 22 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_77.f90 diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index a162744c719..be138d196a2 100644 =2D-- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -5573,11 +5573,14 @@ bool gfc_is_alloc_class_scalar_function (gfc_expr *expr) { if (expr->expr_type =3D=3D EXPR_FUNCTION - && expr->value.function.esym - && expr->value.function.esym->result - && expr->value.function.esym->result->ts.type =3D=3D BT_CLASS - && !CLASS_DATA (expr->value.function.esym->result)->attr.dimension - && CLASS_DATA (expr->value.function.esym->result)->attr.allocatable= ) + && ((expr->value.function.esym + && expr->value.function.esym->result + && expr->value.function.esym->result->ts.type =3D=3D BT_CLASS + && !CLASS_DATA (expr->value.function.esym->result)->attr.dimension + && CLASS_DATA (expr->value.function.esym->result)->attr.allocatable) + || (expr->ts.type =3D=3D BT_CLASS + && CLASS_DATA (expr)->attr.allocatable + && !CLASS_DATA (expr)->attr.dimension))) return true; return false; diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 9f6cc8f871e..d6f4d6bfe45 100644 =2D-- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -8301,7 +8301,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * s= ym, } /* Finalize the result, if necessary. */ - attr =3D CLASS_DATA (expr->value.function.esym->result)->attr; + attr =3D expr->value.function.esym + ? CLASS_DATA (expr->value.function.esym->result)->attr + : CLASS_DATA (expr)->attr; if (!((gfc_is_class_array_function (expr) || gfc_is_alloc_class_scalar_function (expr)) && attr.pointer)) @@ -10085,27 +10087,26 @@ trans_class_vptr_len_assignment (stmtblock_t *bl= ock, gfc_expr * le, if (re->expr_type !=3D EXPR_VARIABLE && re->expr_type !=3D EXPR_NULL && rse->expr !=3D NULL_TREE) { - if (re->ts.type =3D=3D BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE (rs= e->expr))) - class_expr =3D gfc_get_class_from_expr (rse->expr); + if (!DECL_P (rse->expr)) + { + if (re->ts.type =3D=3D BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE (rse->= expr))) + class_expr =3D gfc_get_class_from_expr (rse->expr); - if (rse->loop) - pre =3D &rse->loop->pre; - else - pre =3D &rse->pre; + if (rse->loop) + pre =3D &rse->loop->pre; + else + pre =3D &rse->pre; - if (class_expr !=3D NULL_TREE && UNLIMITED_POLY (re)) - { - tmp =3D TREE_OPERAND (rse->expr, 0); - tmp =3D gfc_create_var (TREE_TYPE (tmp), "rhs"); - gfc_add_modify (&rse->pre, tmp, TREE_OPERAND (rse->expr, 0)); + if (class_expr !=3D NULL_TREE && UNLIMITED_POLY (re)) + tmp =3D gfc_evaluate_now (TREE_OPERAND (rse->expr, 0), &rse->pre); + else + tmp =3D gfc_evaluate_now (rse->expr, &rse->pre); + + rse->expr =3D tmp; } else - { - tmp =3D gfc_create_var (TREE_TYPE (rse->expr), "rhs"); - gfc_add_modify (&rse->pre, tmp, rse->expr); - } + pre =3D &rse->pre; - rse->expr =3D tmp; temp_rhs =3D true; } diff --git a/gcc/testsuite/gfortran.dg/class_77.f90 b/gcc/testsuite/gfortr= an.dg/class_77.f90 new file mode 100644 index 00000000000..ef38dd67743 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_77.f90 @@ -0,0 +1,83 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } +! +! PR fortran/90072 +! +! Contributed by Brad Richardson +! + +module types + implicit none + + type, abstract :: base_returned + end type base_returned + + type, extends(base_returned) :: first_returned + end type first_returned + + type, extends(base_returned) :: second_returned + end type second_returned + + type, abstract :: base_called + contains + procedure(get_), deferred :: get + end type base_called + + type, extends(base_called) :: first_extended + contains + procedure :: get =3D> getFirst + end type first_extended + + type, extends(base_called) :: second_extended + contains + procedure :: get =3D> getSecond + end type second_extended + + abstract interface + function get_(self) result(returned) + import base_called + import base_returned + class(base_called), intent(in) :: self + class(base_returned), allocatable :: returned + end function get_ + end interface +contains + function getFirst(self) result(returned) + class(first_extended), intent(in) :: self + class(base_returned), allocatable :: returned + + allocate(returned, source =3D first_returned()) + end function getFirst + + function getSecond(self) result(returned) + class(second_extended), intent(in) :: self + class(base_returned), allocatable :: returned + + allocate(returned, source =3D second_returned()) + end function getSecond +end module types + +program dispatch_memory_leak + implicit none + + call run() +contains + subroutine run() + use types, only: base_returned, base_called, first_extended + + class(base_called), allocatable :: to_call + class(base_returned), allocatable :: to_get + + allocate(to_call, source =3D first_extended()) + allocate(to_get, source =3D to_call%get()) + + deallocate(to_get) + select type(to_call) + type is (first_extended) + allocate(to_get, source =3D to_call%get()) + end select + end subroutine run +end program dispatch_memory_leak + +! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } } + =2D- 2.45.1 --MP_/ZZLKtxLnT2_Iyb3MxBFwk1V--