I will commit this patch as 'obvious' tomorrow.
Cheers
Paul
2019-02-01 Paul Thomas <pa...@gcc.gnu.org>
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 taking the _data of
the class expression.
2019-02-01 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/88393
* gfortran.dg/alloc_comp_assign_16.f03 : New test.
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 268231)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 6042,6047 ****
--- 6042,6057 ----
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 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)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 6053,6068 ****
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
--- 6063,6068 ----
Index: gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03
===================================================================
*** gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03 (nonexistent)
--- gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03 (working copy)
***************
*** 0 ****
--- 1,37 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR88393 in which a segfault occurred as indicated.
+ !
+ ! Contributed by Janus Weil <ja...@gcc.gnu.org>
+ !
+ 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
