[fortran] PR83763 - PDT dependency in assignment
Commit Message
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
Comments
On 9/14/25 6:04 AM, Paul Richard Thomas wrote:
> 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
Hi Paul,
Reviwed, applied, and tested here ok.
OK for mainline.
Regarding the memory leak, will this be a new PR or an existing one?
Cheers,
Jerry
Hi Jerry,
Thanks for the review and testing. Pushed as r16-3851.
As to the memory leak in pdt_3.f03, I will take a look at it this
morning. I will raise a PR for it whatever I find.
Regards
Paul
On Sun, 14 Sept 2025 at 20:14, Jerry D <jvdelisle2@gmail.com> wrote:
>
> On 9/14/25 6:04 AM, Paul Richard Thomas wrote:
> > 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
>
> Hi Paul,
>
> Reviwed, applied, and tested here ok.
>
> OK for mainline.
>
> Regarding the memory leak, will this be a new PR or an existing one?
>
> Cheers,
>
> Jerry
@@ -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)
@@ -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);
}
}
new file mode 100644
@@ -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 <berke.durak@gmail.com>
+!
+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" } }