| Message ID | 20191023181218.GA62452@troutmask.apl.washington.edu |
|---|---|
| State | New |
| Headers | show |
| Series | PR fortran/92178 -- Re-order argument deallocation | expand |
On 10/23/19 8:12 PM, Steve Kargl wrote: > * trans-expr.c (gfc_conv_procedure_call): Evaluate args and then > deallocate actual args assocated with intent(out) dummies. I think the patch by itself looks fine to me – except that the saw_dealloc is not needed. You can either check "if (dealloc_blk->head)" or you can use gfc_add_block_to_block unconditionally as it handles NULL_TREE. However, the following test case shows that expressions which can be transferred into a tree (se->expr) without needing more evaluations and a temporary (i.e. evaluating things in se->pre) do not work. – The allocated(a) check is really artificial, however, the test() call looks as if it might appear in the real world. First the dump: foo ((integer(kind=4)[0:] * restrict) a.data != 0B, (integer(kind=4)) MAX_EXPR <(D.3958->dim[0].ubound - D.3958->dim[0].lbound) + 1, 0>, test ((integer(kind=4)[0:] * restrict) a.data), &a); And then the test case: implicit none (type, external) integer, allocatable :: a(:) a = [1, 2] call foo(allocated(a), size(a), test(a), a) contains subroutine foo(alloc, sz, tst, x) logical, value :: alloc, tst integer, value :: sz integer, allocatable, intent(out) :: x(:) if (allocated(x)) stop 1 if (.not.alloc) stop 2 if (sz /= 2) stop 3 if (.not. tst) stop 4 end subroutine foo logical function test(zz) integer :: zz(2) test = zz(2) == 2 end function test end Hence, I wonder whether one needs to do (pseudo code): if (any dummy argument is allocatable + intent-out) force_func_eval = true if (actual is an expression + force_func_eval) parmse->expr = gfc_evaluate_now (parmse->expr, &parmse) Such that one uses a temporary variable for those, but keeps the status quo for the rest. > 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. I wonder how to test for it. I tried to create a test case (pr92178-3.f90) but as it turns out, the deallocation happens (via zz->_vptr->_final) directly in the called function and not in the callee. For this one, I was playing with the attached patch – but if one cannot trigger it, it might not be needed. I have also created another test case pr92178-2.f90 which essentially does what pr92178.f90 already did (nearly same code path, covered by your patch). The question is how to proceed from here. Tobias
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