diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 16 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 22 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_26.f03 | 46 |
5 files changed, 92 insertions, 5 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 91771e0..3f3dc3e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2017-12-28 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/83567 + * trans-expr.c (gfc_trans_assignment_1): Free parameterized + components of the lhs if dealloc is set. + *trans-decl.c (gfc_trans_deferred_vars): Do not free the + parameterized components of function results on leaving scope. + 2017_12_27 Louis Krupp <louis.krupp@zoho.com> PR fortran/83092 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index ada38b8..35dee61 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4344,9 +4344,12 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) sym->as ? sym->as->rank : 0, sym->param_list); gfc_add_expr_to_block (&tmpblock, tmp); - tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived, - sym->backend_decl, - sym->as ? sym->as->rank : 0); + if (!sym->attr.result) + 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) @@ -4376,8 +4379,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) sym->param_list); gfc_add_expr_to_block (&tmpblock, tmp); tmp = gfc_class_data_get (sym->backend_decl); - tmp = gfc_deallocate_pdt_comp (data->ts.u.derived, tmp, - data->as ? data->as->rank : 0); + if (!sym->attr.result) + tmp = gfc_deallocate_pdt_comp (data->ts.u.derived, tmp, + data->as ? data->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.c b/gcc/fortran/trans-expr.c index 2ba5c40..30151dd 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -10076,6 +10076,28 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, gfc_trans_runtime_check (true, false, cond, &loop.pre, &expr1->where, msg); } + + /* Deallocate the lhs parameterized components if required. */ + if (dealloc && expr2->expr_type == EXPR_FUNCTION) + { + if (expr1->ts.type == BT_DERIVED + && expr1->ts.u.derived + && expr1->ts.u.derived->attr.pdt_type) + { + tmp = gfc_deallocate_pdt_comp (expr1->ts.u.derived, lse.expr, + expr1->rank); + gfc_add_expr_to_block (&lse.pre, tmp); + } + else if (expr1->ts.type == BT_CLASS + && CLASS_DATA (expr1)->ts.u.derived + && CLASS_DATA (expr1)->ts.u.derived->attr.pdt_type) + { + tmp = gfc_class_data_get (lse.expr); + tmp = gfc_deallocate_pdt_comp (CLASS_DATA (expr1)->ts.u.derived, + tmp, expr1->rank); + gfc_add_expr_to_block (&lse.pre, tmp); + } + } } /* Assignments of scalar derived types with allocatable components diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f8fcc47..2e69175 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-12-28 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/83567 + * gfortran.dg/pdt_26.f90 : New test. + 2017_12_27 Louis Krupp <louis.krupp@zoho.com> PR fortran/83092 diff --git a/gcc/testsuite/gfortran.dg/pdt_26.f03 b/gcc/testsuite/gfortran.dg/pdt_26.f03 new file mode 100644 index 0000000..a4819b0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_26.f03 @@ -0,0 +1,46 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR83567 in which the parameterized component 'foo' was +! being deallocated before return from 'addw', with consequent segfault in +! the main program. +! +! Contributed by Berke Durak <berke.durak@gmail.com> +! The function 'addvv' has been made elemental so that the test can check that +! arrays are correctly treated and that no memory leaks occur. +! +module pdt_m + implicit none + type :: vec(k) + integer, len :: k=3 + integer :: foo(k)=[1,2,3] + end type vec +contains + elemental function addvv(a,b) result(c) + type(vec(k=*)), intent(in) :: a + type(vec(k=*)), intent(in) :: b + type(vec(k=a%k)) :: c + + c%foo=a%foo+b%foo + end function +end module pdt_m + +program test_pdt + use pdt_m + implicit none + type(vec) :: u,v,w, a(2), b(2), c(2) + integer :: i + + u%foo=[1,2,3] + v%foo=[2,3,4] + w=addvv(u,v) + if (any (w%foo .ne. [3,5,7])) call abort + do i = 1 , a(1)%k + a%foo(i) = i + 4 + b%foo(i) = i + 7 + end do + c = addvv(a,b) + if (any (c(1)%foo .ne. [13,15,17])) call abort +end program test_pdt +! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_malloc" 7 "original" } } |