From a878f8e80c753f5ff2726b2eabea7239e93be486 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 18 Jan 2015 15:52:49 +0000 Subject: [PATCH] re PR fortran/64578 ([OOP] Seg-fault and ICE with unlimited polymorphic array pointer function) 2015-01-18 Paul Thomas PR fortran/64578 * trans-expr.c (gfc_trans_subcomponent_assign): Use a deep copy for allocatable components, where the source is a variable. 2015-01-18 Paul Thomas PR fortran/64578 * gfortran.dg/block_13.f08: New test From-SVN: r219818 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-expr.c | 12 +++++- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/block_13.f08 | 58 ++++++++++++++++++++++++++ 4 files changed, 79 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/block_13.f08 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e91159a8d01..3f308f79fc1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2015-01-18 Paul Thomas + + PR fortran/64578 + * trans-expr.c (gfc_trans_subcomponent_assign): Use a deep copy + for allocatable components, where the source is a variable. + 2015-01-18 Paul Thomas PR fortran/55901 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 79eed1e2489..fca6d330119 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6474,8 +6474,16 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); gfc_add_block_to_block (&block, &se.pre); - gfc_add_modify (&block, dest, - fold_convert (TREE_TYPE (dest), se.expr)); + if (cm->ts.u.derived->attr.alloc_comp + && expr->expr_type == EXPR_VARIABLE) + { + tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr, + dest, expr->rank); + gfc_add_expr_to_block (&block, tmp); + } + else + gfc_add_modify (&block, dest, + fold_convert (TREE_TYPE (dest), se.expr)); gfc_add_block_to_block (&block, &se.post); } else diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 34e40ff8d42..8871283b680 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-01-18 Paul Thomas + + PR fortran/64578 + * gfortran.dg/block_13.f08: New test + 2015-01-18 Paul Thomas PR fortran/55901 diff --git a/gcc/testsuite/gfortran.dg/block_13.f08 b/gcc/testsuite/gfortran.dg/block_13.f08 new file mode 100644 index 00000000000..5956a90c240 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/block_13.f08 @@ -0,0 +1,58 @@ +! { dg-do run } +! Checks the fix for PR57959. The first assignment to a was proceeding +! without a deep copy. Since the anum field of 'uKnot' was being pointed +! to twice, the frees in the finally block, following the BLOCK caused +! a double free. +! +! Contributed by Tobias Burnus +! +program main + implicit none + type :: type1 + real, allocatable :: anum + character(len = :), allocatable :: chr + end type type1 + real, parameter :: five = 5.0 + real, parameter :: point_one = 0.1 + + type :: type2 + type(type1) :: temp + end type type2 + block + type(type1) :: uKnot + type(type2) :: a + + uKnot = type1 (five, "hello") + call check (uKnot%anum, five) + call check_chr (uKnot%chr, "hello") + + a = type2 (uKnot) ! Deep copy needed here + call check (a%temp%anum, five) + call check_chr (a%temp%chr, "hello") + + a = type2 (type1(point_one, "goodbye")) ! Not here + call check (a%temp%anum, point_one) + call check_chr (a%temp%chr, "goodbye") + + a = type2 (foo (five)) ! Not here + call check (a%temp%anum, five) + call check_chr (a%temp%chr, "foo set me") + end block +contains + subroutine check (arg1, arg2) + real :: arg1, arg2 + if (arg1 .ne. arg2) call abort () + end subroutine + + subroutine check_chr (arg1, arg2) + character(*) :: arg1, arg2 + if (len (arg1) .ne. len (arg2)) call abort + if (arg1 .ne. arg2) call abort + end subroutine + + type(type1) function foo (arg) + real :: arg + foo = type1 (arg, "foo set me") + end function +end + -- 2.30.2