[Patch, fortran] PR64290 - [F03] No finalization at deallocation of LHS
Hi All, Strictly speaking, the attached patch is branching out into a more generalised attack on PR37336(Finalization) - [F03] Finish derived-type finalization but most of it fixes PR64290. I started work on this patch almost a year ago but had to drop it due daytime work pressure and only picked it up again a couple of weeks back. It is not, as yet, complete but I thought to post it in its present form because stage 3 ended yesterday. The main thrusts of the patch are: (i) To correct the order taken by finalization and deallocation of components for the lhs of assignments. This is done instead by a call to Tobias' finalization wrapper, rather than performing finalization component by component in structure_alloc_comps; (ii) To add finalization of scalar derived type function results, again by use of the finalization wrapper. This points to a problem that I haven't yet managed to fix, F2018(7.5.6.3 para 5) "If an executable construct references a nonpointer function, the result is finalized after execution of the innermost executable construct containing the reference." I have been struggling to avoid implementing this by introducing a finalization block into gfc_se but have run out of ideas as to how to do it otherwise. (eg. Try using a finalizable function as the actual argument of another procedure.); and (iii) Once (ii) is added, a segfault occurs if the derived type has allocatable, finalizable components. (PR96122) This occurred because the call to the component finalization wrapper was missing two arguments in the call; most particularly 'byte_stride'. There is still quite a lot to do to bring together common code chunks, fix the ordering requirement of F2018 (7.5.6.3 para 5), add more testcases. It's certainly not ready to be committed yet :-( Regards Paul Fortran:Implement missing finalization features [PR64290] 2022-01-17 Paul Thomas gcc/fortran PR fortran/103854 * class.c (has_finalizer_component): Do not return true for procedure pointer components. PR fortran/96087 * class.c (finalize_component): Include the missing arguments in the call to the component's finalizer wrapper. PR fortran/64290 * resolve.c (resolve_where, gfc_resolve_where_code_in_forall, gfc_resolve_forall_body, gfc_resolve_code): Check that the op code is still EXEC_ASSIGN. If it is set lhs to must finalize. * trans-array.c (structure_alloc_comps): Add boolean argument to suppress finalization and use it for calls from gfc_deallocate_alloc_comp_no_caf. Otherwise it defaults to false. (gfc_alloc_allocatable_for_assignment): Suppress finalization by setting new arg in call to gfc_deallocate_alloc_comp_no_caf. * trans-array.h : Add the new boolean argument to the prototype of gfc_deallocate_alloc_comp_no_caf with a default of false. * trans-expr.c (gfc_conv_procedure_call): Call finalizer for finalizable scalar function results. (gfc_trans_scalar_assign): Suppress finalization by setting new argument in call to gfc_deallocate_alloc_comp_no_caf. (gfc_assignment_finalizer_call): New function to provide finalization on intrinsic assignment. (trans_class_assignment, gfc_trans_assignment_1): Call it and add the block between the rhs evaluation and any reallocation on assignment that there might be. gcc/testsuite/ PR fortran/64290 * gfortran.dg/finalize_38.f90 : New test. * gfortran.dg/allocate_with_source_25.f90 : The number of final calls goes down from 6 to 4. diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 2cb0c6572bd..18289eaffe8 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -896,7 +896,8 @@ has_finalizer_component (gfc_symbol *derived) gfc_component *c; for (c = derived->components; c; c = c->next) -if (c->ts.type == BT_DERIVED && !c->attr.pointer && !c->attr.allocatable) +if (c->ts.type == BT_DERIVED && !c->attr.pointer && !c->attr.allocatable + && c->attr.flavor != FL_PROCEDURE) { if (c->ts.u.derived->f2k_derived && c->ts.u.derived->f2k_derived->finalizers) @@ -1059,7 +1060,8 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, { /* Call FINAL_WRAPPER (comp); */ gfc_code *final_wrap; - gfc_symbol *vtab; + gfc_symbol *vtab, *byte_stride; + gfc_expr *scalar, *size_expr, *fini_coarray_expr; gfc_component *c; vtab = gfc_find_derived_vtab (comp->ts.u.derived); @@ -1068,12 +1070,54 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, break; gcc_assert (c); + + /* Set scalar argument for storage_size. */ + gfc_get_symbol ("comp_byte_stride", sub_ns, _stride); + byte_stride->ts = e->ts; + byte_stride->attr.flavor = FL_VARIABLE; + byte_stride->attr.value = 1; + byte_stride->attr.artificial = 1; + gfc_set_sym_referenced (byte_stride); + gfc_commit_symbol (byte_stride); + scalar = gfc_lval_expr_from_sym (byte_stride); + final_wrap = gfc_get_code (EXEC_CALL); final_wrap->symtree =
[Patch, fortran] PR64290 - [F03] No finalization at deallocation of LHS
Hi All, This patch was triggered by a thread on clf. Some years ago Tobias and I discussed the remaining conditions where finalization should be triggered and is not. Intrinsic assignment was one of the glaring omissions for which implementation looked like a heavy lift job. As it happens, it wasn't too bad :-) Most of the work was suppressing partial finalization, as a prelude to reallocation on assignment, and ensuring that finalization happened in the right circumstances. gfc_assignment_finalizer_call does the work for intrinsic assignment and is straightforward. Care has to be taken to place the result between evaluation of the rhs and any reallocation of the lhs that might occur. I thought it to be a good idea to squeeze this in before Stage 4 and so the testcase is not yet finished.I will post it separately once complete and before pushing the patch. The process is a bit tedious since it involves checking that the finalization is occurring at the correct point in the assignment, that the results are consistent with my understanding of 7.5.6.3 and that another brand gives the same results. Regtests on FC33/x86_64 - OK for master? It occurs to me that this should also be backported to the 10-branch at very least. Paul Fortran:Implement finalization on intrinsic assignment [PR64290] 2021-01-14 Paul Thomas gcc/fortran PR fortran/64290 * resolve.c (resolve_where, gfc_resolve_where_code_in_forall, gfc_resolve_forall_body, gfc_resolve_code): Check that the op code is still EXEC_ASSIGN. If it is set lhs to must finalize. * trans-array.c (structure_alloc_comps): Add boolean argument to suppress finalization and use it for calls from gfc_deallocate_alloc_comp_no_caf. Otherwise it defaults to false. (gfc_alloc_allocatable_for_assignment): Suppress finalization by setting new arg in call to gfc_deallocate_alloc_comp_no_caf. * trans-array.h : Add the new boolean argument to the prototype of gfc_deallocate_alloc_comp_no_caf with a default of false. * trans-expr.c (gfc_trans_scalar_assign): Suppress finalization by setting new arg in call to gfc_deallocate_alloc_comp_no_caf. (gfc_assignment_finalizer_call): New function to provide finalization on intrinsic assignment. (gfc_trans_assignment_1): Call it and add the block between the rhs evaluation and any reallocation on assignment that there might be. gcc/testsuite/ PR fortran/64290 * gfortran.dg/finalize_38.f90 : New test. * gfortran.dg/allocate_with_source_16.f90 : The number of final calls goes down from 6 to 4. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f243bd185b0..05f52185b8b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10415,6 +10415,10 @@ resolve_where (gfc_code *code, gfc_expr *mask) if (e && !resolve_where_shape (cnext->expr1, e)) gfc_error ("WHERE assignment target at %L has " "inconsistent shape", >expr1->where); + + if (cnext->op == EXEC_ASSIGN) + cnext->expr1->must_finalize = 1; + break; @@ -10502,6 +10506,10 @@ gfc_resolve_where_code_in_forall (gfc_code *code, int nvar, /* WHERE assignment statement */ case EXEC_ASSIGN: gfc_resolve_assign_in_forall (cnext, nvar, var_expr); + + if (cnext->op == EXEC_ASSIGN) + cnext->expr1->must_finalize = 1; + break; /* WHERE operator assignment statement */ @@ -10548,6 +10556,10 @@ gfc_resolve_forall_body (gfc_code *code, int nvar, gfc_expr **var_expr) case EXEC_ASSIGN: case EXEC_POINTER_ASSIGN: gfc_resolve_assign_in_forall (c, nvar, var_expr); + + if (c->op == EXEC_ASSIGN) + c->expr1->must_finalize = 1; + break; case EXEC_ASSIGN_CALL: @@ -11947,6 +11959,9 @@ start: && code->expr1->ts.u.derived->attr.defined_assign_comp) generate_component_assignments (, ns); + if (code->op == EXEC_ASSIGN) + code->expr1->must_finalize = 1; + break; case EXEC_LABEL_ASSIGN: diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 4bd4db877bd..8ac6b9e88fb 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8661,7 +8661,7 @@ static gfc_actual_arglist *pdt_param_list; static tree structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, int rank, int purpose, int caf_mode, - gfc_co_subroutines_args *args) + gfc_co_subroutines_args *args, bool no_finalization) { gfc_component *c; gfc_loopinfo loop; @@ -8749,11 +8749,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_conv_array_data (dest)); dref = gfc_build_array_ref (tmp, index, NULL); tmp = structure_alloc_comps (der_type, vref, dref, rank, - COPY_ALLOC_COMP, caf_mode, args); + COPY_ALLOC_COMP, caf_mode, args, + no_finalization); } else tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose, - caf_mode, args); + caf_mode, args, no_finalization); gfc_add_expr_to_block (, tmp); @@ -8787,13 +8788,15 @@