From: Paul Thomas Date: Sat, 2 Feb 2019 09:23:30 +0000 (+0000) Subject: re PR fortran/88393 ([OOP] Segfault with type-bound assignment) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a3df90b9672562d0e2feeb093e20c1d21bd4cca5;p=gcc.git re PR fortran/88393 ([OOP] Segfault with type-bound assignment) 2019-02-02 Paul Thomas PR fortran/88393 * trans-expr.c (gfc_conv_procedure_call): For derived entities, passed in parentheses to class formals, invert the order of copying allocatable components to taking the _data of the class expression. 2019-02-02 Paul Thomas PR fortran/88393 * gfortran.dg/alloc_comp_assign_16.f03 : New test. From-SVN: r268474 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6dba135459f..ce6df90aa77 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2019-02-02 Paul Thomas + + PR fortran/88393 + * trans-expr.c (gfc_conv_procedure_call): For derived entities, + passed in parentheses to class formals, invert the order of + copying allocatable components to taking the _data of the + class expression. + 2019-02-02 Paul Thomas PR fortran/88980 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 1cbef7f4c29..e7c75913bfe 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6042,6 +6042,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, break; } + if (e->ts.type == BT_DERIVED && fsym && fsym->ts.type == BT_CLASS) + { + /* The derived type is passed to gfc_deallocate_alloc_comp. + Therefore, class actuals can be handled correctly but derived + types passed to class formals need the _data component. */ + tmp = gfc_class_data_get (tmp); + if (!CLASS_DATA (fsym)->attr.dimension) + tmp = build_fold_indirect_ref_loc (input_location, tmp); + } + if (e->expr_type == EXPR_OP && e->value.op.op == INTRINSIC_PARENTHESES && e->value.op.op1->expr_type == EXPR_VARIABLE) @@ -6053,16 +6063,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_add_expr_to_block (&se->post, local_tmp); } - if (e->ts.type == BT_DERIVED && fsym && fsym->ts.type == BT_CLASS) - { - /* The derived type is passed to gfc_deallocate_alloc_comp. - Therefore, class actuals can handled correctly but derived - types passed to class formals need the _data component. */ - tmp = gfc_class_data_get (tmp); - if (!CLASS_DATA (fsym)->attr.dimension) - tmp = build_fold_indirect_ref_loc (input_location, tmp); - } - if (!finalized && !e->must_finalize) { if ((e->ts.type == BT_CLASS diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d94a3be1746..727dc4bf43b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-02-02 Paul Thomas + + PR fortran/88393 + * gfortran.dg/alloc_comp_assign_16.f03 : New test. + 2019-02-02 Paul Thomas PR fortran/88980 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03 new file mode 100644 index 00000000000..892ea172e20 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03 @@ -0,0 +1,37 @@ +! { dg-do run } +! +! Test the fix for PR88393 in which a segfault occurred as indicated. +! +! Contributed by Janus Weil +! +module m + implicit none + type :: t + character(len=:), allocatable :: cs + contains + procedure :: ass + generic :: assignment(=) => ass + end type +contains + subroutine ass(a, b) + class(t), intent(inout) :: a + class(t), intent(in) :: b + a%cs = b%cs + print *, "ass" + end subroutine +end module + +program p + use m + implicit none + type :: t2 + type(t) :: c + end type + type(t2), dimension(1:2) :: arr + arr(1)%c%cs = "abcd" + arr(2)%c = arr(1)%c ! Segfault here. + print *, "done", arr(2)%c%cs, arr(2)%c%cs +! Make sure with valgrind that there are no memory leaks. + deallocate (arr(1)%c%cs) + deallocate (arr(2)%c%cs) +end