Fortran - fix handling of optional allocatable DT arguments with INTENT(OUT)
gcc/fortran/ChangeLog: PR fortran/102287 * trans-expr.c (gfc_conv_procedure_call): Wrap deallocation of allocatable components of optional allocatable derived type procedure arguments with INTENT(OUT) into a presence check. gcc/testsuite/ChangeLog: PR fortran/102287 * gfortran.dg/intent_out_14.f90: New test.
This commit is contained in:
parent
db1a65d936
commit
cfea7b86f2
2 changed files with 35 additions and 0 deletions
|
@ -6548,6 +6548,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
// deallocate the components first
|
||||
tmp = gfc_deallocate_alloc_comp (fsym->ts.u.derived,
|
||||
parmse.expr, e->rank);
|
||||
/* But check whether dummy argument is optional. */
|
||||
if (tmp != NULL_TREE
|
||||
&& fsym->attr.optional
|
||||
&& e->expr_type == EXPR_VARIABLE
|
||||
&& e->symtree->n.sym->attr.optional)
|
||||
{
|
||||
tree present;
|
||||
present = gfc_conv_expr_present (e->symtree->n.sym);
|
||||
tmp = build3_v (COND_EXPR, present, tmp,
|
||||
build_empty_stmt (input_location));
|
||||
}
|
||||
if (tmp != NULL_TREE)
|
||||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
}
|
||||
|
|
24
gcc/testsuite/gfortran.dg/intent_out_14.f90
Normal file
24
gcc/testsuite/gfortran.dg/intent_out_14.f90
Normal file
|
@ -0,0 +1,24 @@
|
|||
! { dg-do run }
|
||||
! PR fortran/102287 - optional allocatable DT array arguments (intent out)
|
||||
|
||||
module m
|
||||
type t
|
||||
integer, allocatable :: a
|
||||
end type t
|
||||
contains
|
||||
subroutine a (x, v)
|
||||
type(t), optional, allocatable, intent(out) :: x(:)
|
||||
type(t), optional, intent(out) :: v(:)
|
||||
call b (x, v)
|
||||
end subroutine a
|
||||
|
||||
subroutine b (y, w)
|
||||
type(t), optional, allocatable, intent(out) :: y(:)
|
||||
type(t), optional, intent(out) :: w(:)
|
||||
end subroutine b
|
||||
end module m
|
||||
|
||||
program p
|
||||
use m
|
||||
call a ()
|
||||
end
|
Loading…
Add table
Reference in a new issue