The attached patch has been tested on x86_64-*-freebsd. OK to commit? 2019-10-23 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/92178 * trans-expr.c (gfc_conv_procedure_call): Evaluate args and then deallocate actual args assocated with intent(out) dummies. 2019-10-23 Steven G. Kargl <ka...@gcc.gnu.org> PR fortran/92178 * gfortran.dg/pr92178.f90: New test. Note, in gfc_conv_procedure_call() there are 3 blocks of code that deal with the deallocation of actual arguments assocated with intent(out) dummy arguments. The patch affects the first and third blocks. The 2nd block, lines 6071-6111, concerns CLASS and finalization. I use neither, so have no idea what Fortran requires. More importantly, I have very little understanding of gfortran's internal implementation for CLASS and finalization. Someone who cares about CLASS and finalization will need to consider how to possibly fix a possible issue. -- Steve
Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (revision 277296) +++ gcc/fortran/trans-expr.c (working copy) @@ -5405,6 +5405,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym gfc_component *comp = NULL; int arglen; unsigned int argc; + stmtblock_t dealloc_blk; + bool saw_dealloc = false; arglist = NULL; retargs = NULL; @@ -5445,6 +5447,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym info = NULL; gfc_init_block (&post); + gfc_init_block (&dealloc_blk); gfc_init_interface_mapping (&mapping); if (!comp) { @@ -5976,8 +5979,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym } else tmp = gfc_finish_block (&block); - - gfc_add_expr_to_block (&se->pre, tmp); + saw_dealloc = true; + gfc_add_expr_to_block (&dealloc_blk, tmp); } if (fsym && (fsym->ts.type == BT_DERIVED @@ -6265,7 +6268,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym void_type_node, gfc_conv_expr_present (e->symtree->n.sym), tmp, build_empty_stmt (input_location)); - gfc_add_expr_to_block (&se->pre, tmp); + saw_dealloc = true; + gfc_add_expr_to_block (&dealloc_blk, tmp); } } } @@ -6636,6 +6640,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym vec_safe_push (arglist, parmse.expr); } + if (saw_dealloc) + gfc_add_block_to_block (&se->pre, &dealloc_blk); gfc_finish_interface_mapping (&mapping, &se->pre, &se->post); if (comp) Index: gcc/testsuite/gfortran.dg/pr92178.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr92178.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr92178.f90 (working copy) @@ -0,0 +1,22 @@ +! { dg-do run } +! Original code contributed by Vladimir Fuka +! PR fortran/92178 +program foo + + implicit none + + integer, allocatable :: a(:) + + allocate(a, source=[1]) + + call assign(a, (a(1))) + + if (allocated(a) .neqv. .false.) stop 1 + + contains + subroutine assign(a, b) + integer, allocatable, intent(out) :: a(:) + integer :: b + if (b /= 1) stop 2 + end subroutine +end program