From patchwork Sun Sep 14 13:04:35 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 120216 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 977453858C51 for ; Sun, 14 Sep 2025 13:05:38 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 977453858C51 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, unprotected) header.d=gmail.com header.i=@gmail.com header.a=rsa-sha256 header.s=20230601 header.b=DFz1WbvN X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-pj1-x102b.google.com (mail-pj1-x102b.google.com [IPv6:2607:f8b0:4864:20::102b]) by sourceware.org (Postfix) with ESMTPS id 6CE973858D39 for ; Sun, 14 Sep 2025 13:04:48 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 6CE973858D39 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 6CE973858D39 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::102b ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757855088; cv=none; b=XK76g3F4X70tb29705rPHdF9UvwT0ywIGBLk6Jwxt17RMRlFKTmO3pCxo5uAoDB5bIqo34cPx+HC6RmGDCWJUuoIwvoEh4oWPHkrs0rnP98iWlw2q1VkFObwU5OWxZlnUqAwdJh2dySfAClbZr3U/TMBrleUHMiD45yaETStoc0= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757855088; c=relaxed/simple; bh=3saO4GVrszb2uTs7OpaR9RiLKHLOW44JwmjnsyjcANk=; h=DKIM-Signature:MIME-Version:From:Date:Message-ID:Subject:To; b=rYbr8uytONT1fptN6zKQ+SfG+jOvvNyOW2DyM+DacFbWWoEeDTYqhpZwubi1QsAdTaIrKq54/aMV+SITdhvNk3/2Ex6vzFTWTrspN/GRxpuEZxsMyDIzffziSItLvSw54phl84N/8qrMZQKD3wsH2d9dp/OIki7WVr1JRlPSDOc= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6CE973858D39 Received: by mail-pj1-x102b.google.com with SMTP id 98e67ed59e1d1-32e11f35c0dso664694a91.0 for ; Sun, 14 Sep 2025 06:04:48 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1757855087; x=1758459887; darn=gcc.gnu.org; h=to:subject:message-id:date:from:mime-version:from:to:cc:subject :date:message-id:reply-to; bh=3saO4GVrszb2uTs7OpaR9RiLKHLOW44JwmjnsyjcANk=; b=DFz1WbvNb0cv97AFG80KoAaJ15ljzCXFSMOeyKu7G8wrdMf7BWMYNxwKFjJh6i/Zty b4qCA9uAw56VtrRfjHghgKzcS4GdHu6zdIaacyc0o2wxG6lp+kkg0gUib1qasCyUghDG tHOtoSt5vyiPLLPy8A9Pf5Hcnpx/rP9oqCgn9L9WussT/z6ReKAYSTo8tLxC5l3fr+N5 RHTUnHCUHwoKy0EvccAabJM+FTuDYUCjGbgSmG1ULws1le2OoMeF5qFb9u0LY71sgAAp MW1ISaUSjPuw0/EAmRIVQ3oOeE2ZOWpQES7Qvo2lJfhcCkTbpWxGWsg9h6MvyG5aFJ53 YlMA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757855087; x=1758459887; h=to:subject:message-id:date:from:mime-version:x-gm-message-state :from:to:cc:subject:date:message-id:reply-to; bh=3saO4GVrszb2uTs7OpaR9RiLKHLOW44JwmjnsyjcANk=; b=hQSh/LOKrN/N0sa5uhXzeX3A4hebe6AkxJHjOS7NN/+1a0OtXH5xs7ukPU+/KdyTu5 2TcP+7NPfpbIITp9pItO4/VQzmC8moLI4XA/FR3TqlfAZPoLworZd2k+BpRUyuEGhdP3 QpfensCuOi37SYw6FSmZIBsxB2mAvsZORetqmPCG3e/idAil7LjHAUyb5wuL2u2Z691M U2nH1Spzj2GfUjp9e1SuoMYJEcKEePQ/KrgSGVELjczb3EQp9aJLmdjYmMc4iLU0tiOD CaSGBNrm22dlwPwR0uy5W/MzwSSuFst044qIvU5ecFdL6Vl5a0JUBYg/423aj8Q2cNVB uM8A== X-Forwarded-Encrypted: i=1; AJvYcCXqNHp98eOyq5BW/SG1XEeYH8HNQs1b7P3meIQmGpJw7PY0M2/+DQudHLhan1rAQuGzJohelzz3gvGRbA==@gcc.gnu.org X-Gm-Message-State: AOJu0Yw05ZeCVa1EUD9Ksul8ewiM+h43wkx5UBLlwHLYKl3AEIBNpF1M JPCKdlarqww8/9P++Jp7h6OqDogNp6MF9uONRULFSl5AHUxT0rhm3rX/c8GyIkV4vh+O0+HZYz+ uPRHosMjatj1Yq8kV9onUiEnS+gP1QcU= X-Gm-Gg: ASbGncsr9qN2dzvsrF7mOpzYE3tZa1ZaTHcbEsTXKmWK6mI+rEIl9c/rK+XAG+x2uA4 U89AeC0wAl+w0qO1RAJYEgac320kbin4V0Q5wF2AoCrpSwKaGAj80X8hpmS2Xlb+2pnxklUp/zq VH65iWNflN1nyZSuZ0Kgr5IizPW3BriEl81e0sIiwEKBahYhKmxiAc5ovKEve/PfFXT67DC1Rrq Kr0+/LqMXFV7q9YX2jCy1RDkWsMi9RqH7vjhCvRwZ6dy8lpqYkJ X-Google-Smtp-Source: AGHT+IEfI/bj5DMD8anxRztkvziSbsPVUjYlojQNldIyB9vtczpJQy8smuMUorvxH2pxpEiUoHHTcPjuiydsR0l00u8= X-Received: by 2002:a17:90b:518f:b0:30a:4874:5397 with SMTP id 98e67ed59e1d1-32de4eb6cc7mr8296885a91.9.1757855087158; Sun, 14 Sep 2025 06:04:47 -0700 (PDT) MIME-Version: 1.0 From: Paul Richard Thomas Date: Sun, 14 Sep 2025 14:04:35 +0100 X-Gm-Features: Ac12FXx9fLzto9spjfP5ABEw-xGIOINQfRumtJmUSnpWHN7zzprV1_Ngq2_5DPg Message-ID: Subject: [Patch, fortran] PR83763 - PDT dependency in assignment To: "fortran@gcc.gnu.org" , gcc-patches , Jerry DeLisle X-Spam-Status: No, score=-7.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 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 Hi All, The title in the PR is, "Bug 83763 - PDT variable sees content deallocated if variable is passed as an input to a function, and the function result is assigned to that same variable". The above is slightly more concise! The fix for the PR itself comprises the chunks in trans-expr.cc. On checking the allocatable version, I found a memory leak, which necessitated the chunks in trans-decl.cc. On implementing the changes in trans-decl.cc for class entities, a segfault resulted in pdt_3.f03. This also uncovered a memory leak in the allocation with source in this test. I will investigate further. Other than these remarks, the patch is straightforward and regtests on FC42/x86_64. OK for mainline? Paul diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index b077cee86a3..23cf7f58567 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -4874,21 +4874,24 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) { is_pdt_type = true; gfc_init_block (&tmpblock); - if (!(sym->attr.dummy - || sym->attr.pointer - || sym->attr.allocatable)) + if (!sym->attr.dummy && !sym->attr.pointer) { - tmp = gfc_allocate_pdt_comp (sym->ts.u.derived, - sym->backend_decl, - sym->as ? sym->as->rank : 0, - sym->param_list); - gfc_add_expr_to_block (&tmpblock, tmp); - if (!sym->attr.result) + if (!sym->attr.allocatable) + { + tmp = gfc_allocate_pdt_comp (sym->ts.u.derived, + sym->backend_decl, + sym->as ? sym->as->rank : 0, + sym->param_list); + gfc_add_expr_to_block (&tmpblock, tmp); + } + + if (!sym->attr.result && !sym->ts.u.derived->attr.alloc_comp) tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived, sym->backend_decl, sym->as ? sym->as->rank : 0); else tmp = NULL_TREE; + gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), tmp); } else if (sym->attr.dummy) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index a9ea29f760f..9892735d5de 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -13143,26 +13143,39 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, } /* Deallocate the lhs parameterized components if required. */ - if (dealloc && expr2->expr_type == EXPR_FUNCTION - && !expr1->symtree->n.sym->attr.associate_var) + if (dealloc + && !expr1->symtree->n.sym->attr.associate_var + && ((expr1->ts.type == BT_DERIVED + && expr1->ts.u.derived + && expr1->ts.u.derived->attr.pdt_type) + || (expr1->ts.type == BT_CLASS + && CLASS_DATA (expr1)->ts.u.derived + && CLASS_DATA (expr1)->ts.u.derived->attr.pdt_type))) { - if (expr1->ts.type == BT_DERIVED - && expr1->ts.u.derived - && expr1->ts.u.derived->attr.pdt_type) + bool pdt_dep = gfc_check_dependency (expr1, expr2, true); + + tmp = lse.expr; + if (pdt_dep) { - tmp = gfc_deallocate_pdt_comp (expr1->ts.u.derived, lse.expr, - expr1->rank); - gfc_add_expr_to_block (&lse.pre, tmp); + /* Create a temporary for deallocation after assignment. */ + tmp = gfc_create_var (TREE_TYPE (lse.expr), "pdt_tmp"); + gfc_add_modify (&lse.pre, tmp, lse.expr); } - else if (expr1->ts.type == BT_CLASS - && CLASS_DATA (expr1)->ts.u.derived - && CLASS_DATA (expr1)->ts.u.derived->attr.pdt_type) + + if (expr1->ts.type == BT_DERIVED) + tmp = gfc_deallocate_pdt_comp (expr1->ts.u.derived, tmp, + expr1->rank); + else if (expr1->ts.type == BT_CLASS) { - tmp = gfc_class_data_get (lse.expr); + tmp = gfc_class_data_get (tmp); tmp = gfc_deallocate_pdt_comp (CLASS_DATA (expr1)->ts.u.derived, tmp, expr1->rank); - gfc_add_expr_to_block (&lse.pre, tmp); } + + if (tmp && pdt_dep) + gfc_add_expr_to_block (&rse.post, tmp); + else if (tmp) + gfc_add_expr_to_block (&lse.pre, tmp); } } diff --git a/gcc/testsuite/gfortran.dg/pdt_46.f03 b/gcc/testsuite/gfortran.dg/pdt_46.f03 new file mode 100644 index 00000000000..67d32df66a5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_46.f03 @@ -0,0 +1,62 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR83763 in which a dependency was not handled correctly, which +! resulted in a runtime segfault. +! +! Contributed by Berke Durak +! +module bar + implicit none + + type :: foo(n) + integer, len :: n = 10 + real :: vec(n) + end type foo + +contains + + function baz(a) result(b) + type(foo(n = *)), intent(in) :: a + type(foo(n = a%n)) :: b + + b%vec = a%vec * 10 + end function baz + +end module bar + +program test + use bar + implicit none + call main1 ! Original report + call main2 ! Check for memory loss with allocatable 'x' and 'y'. + +contains + + subroutine main1 + type(foo(5)) :: x, y + integer :: a(5) = [1,2,3,4,5] + + x = foo(5)(a) + x = baz (x) ! Segmentation fault because dependency not handled. + if (any (x%vec /= 10 * a)) stop 1 + y = x + x = baz (y) ! No dependecy and so this worked. + if (any (x%vec /= 100 * a)) stop 2 + end subroutine main1 + + subroutine main2 + type(foo(5)), allocatable :: x, y + integer :: a(5) = [1,2,3,4,5] + + x = foo(5)(a) + x = baz (x) ! Segmentation fault because dependency not handled. + if (any (x%vec /= 10 * a)) stop 3 + y = x + x = baz (y) ! No dependecy and so this worked. + if (any (x%vec /= 100 * a)) stop 4 + end subroutine main2 + +end program test +! { dg-final { scan-tree-dump-times "__builtin_free" 16 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_malloc" 12 "original" } }