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
Change.Logs
Description: Binary data
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 <berke.du...@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" } }
