re PR fortran/88393 ([OOP] Segfault with type-bound assignment)

2019-02-02  Paul Thomas  <pault@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 the _data of the
	class expression.

2019-02-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/88393
	* gfortran.dg/alloc_comp_assign_16.f03 : New test.

From-SVN: r268474
This commit is contained in:
Paul Thomas 2019-02-02 09:23:30 +00:00
parent da46c08e8b
commit a3df90b967
4 changed files with 60 additions and 10 deletions

View File

@ -1,3 +1,11 @@
2019-02-02 Paul Thomas <pault@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 the _data of the
class expression.
2019-02-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/88980

View File

@ -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

View File

@ -1,3 +1,8 @@
2019-02-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/88393
* gfortran.dg/alloc_comp_assign_16.f03 : New test.
2019-02-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/88980

View File

@ -0,0 +1,37 @@
! { dg-do run }
!
! Test the fix for PR88393 in which a segfault occurred as indicated.
!
! Contributed by Janus Weil <janus@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