https://gcc.gnu.org/g:d1f05661fa6c8a6ea6f59ad365a84469100e425e
commit r16-2086-gd1f05661fa6c8a6ea6f59ad365a84469100e425e Author: Andre Vehreschild <ve...@gcc.gnu.org> Date: Wed Jun 25 14:46:16 2025 +0200 Fortran: Ensure finalizers are created correctly [PR120637] Finalize_component freeed an expression that it used to remember which components in which context it had finalized already. While it makes sense to free the copy of the expression, if it is unused, it causes issues, when comparing to a non existent expression. This is now detected by returning true, when the expression has been used. PR fortran/120637 gcc/fortran/ChangeLog: * class.cc (finalize_component): Return true, when a finalizable component was detect and do not free it. gcc/testsuite/ChangeLog: * gfortran.dg/asan/finalize_1.f90: New test. Diff: --- gcc/fortran/class.cc | 24 ++++++---- gcc/testsuite/gfortran.dg/asan/finalize_1.f90 | 67 +++++++++++++++++++++++++++ 2 files changed, 81 insertions(+), 10 deletions(-) diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc index df18601e45bd..a1c6fafa75ef 100644 --- a/gcc/fortran/class.cc +++ b/gcc/fortran/class.cc @@ -1034,7 +1034,7 @@ comp_is_finalizable (gfc_component *comp) of calling the appropriate finalizers, coarray deregistering, and deallocation of allocatable subcomponents. */ -static void +static bool finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, gfc_symbol *stat, gfc_symbol *fini_coarray, gfc_code **code, gfc_namespace *sub_ns) @@ -1044,14 +1044,14 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, gfc_was_finalized *f; if (!comp_is_finalizable (comp)) - return; + return false; /* If this expression with this component has been finalized already in this namespace, there is nothing to do. */ for (f = sub_ns->was_finalized; f; f = f->next) { if (f->e == expr && f->c == comp) - return; + return false; } e = gfc_copy_expr (expr); @@ -1208,8 +1208,6 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, final_wrap->ext.actual->next->next = gfc_get_actual_arglist (); final_wrap->ext.actual->next->next->expr = fini_coarray_expr; - - if (*code) { (*code)->next = final_wrap; @@ -1221,11 +1219,14 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, else { gfc_component *c; + bool ret = false; for (c = comp->ts.u.derived->components; c; c = c->next) - finalize_component (e, comp->ts.u.derived, c, stat, fini_coarray, code, - sub_ns); - gfc_free_expr (e); + ret |= finalize_component (e, comp->ts.u.derived, c, stat, fini_coarray, + code, sub_ns); + /* Only free the expression, if it has never been used. */ + if (!ret) + gfc_free_expr (e); } /* Record that this was finalized already in this namespace. */ @@ -1234,6 +1235,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, sub_ns->was_finalized->e = expr; sub_ns->was_finalized->c = comp; sub_ns->was_finalized->next = f; + return true; } @@ -2314,6 +2316,7 @@ finish_assumed_rank: { gfc_symbol *stat; gfc_code *block = NULL; + gfc_expr *ptr_expr; if (!ptr) { @@ -2359,14 +2362,15 @@ finish_assumed_rank: sub_ns); block = block->next; + ptr_expr = gfc_lval_expr_from_sym (ptr); for (comp = derived->components; comp; comp = comp->next) { if (comp == derived->components && derived->attr.extension && ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL) continue; - finalize_component (gfc_lval_expr_from_sym (ptr), derived, comp, - stat, fini_coarray, &block, sub_ns); + finalize_component (ptr_expr, derived, comp, stat, fini_coarray, + &block, sub_ns); if (!last_code->block->next) last_code->block->next = block; } diff --git a/gcc/testsuite/gfortran.dg/asan/finalize_1.f90 b/gcc/testsuite/gfortran.dg/asan/finalize_1.f90 new file mode 100644 index 000000000000..ab53a9ecf2be --- /dev/null +++ b/gcc/testsuite/gfortran.dg/asan/finalize_1.f90 @@ -0,0 +1,67 @@ +!{ dg-do run } + +! PR fortran/120637 + +! Contributed by Antony Lewis <ant...@cosmologist.info> +! The unused module is needed to trigger the issue of not freeing the +! memory of second module. + + module MiscUtils + implicit none + + contains + + logical function isFloat0(R) + class(*), intent(in) :: R + + select type(R) + type is (real) + isFloat0 = .true. + end select + end function isFloat0 + + end module MiscUtils + + module results3 + implicit none + public + + Type ClTransferData2 + real, dimension(:,:,:), allocatable :: Delta_p_l_k + end type ClTransferData2 + + type TCLdata2 + Type(ClTransferData2) :: CTransScal, CTransTens, CTransVec + end type TCLdata2 + + type :: CAMBdata2 + Type(TClData2) :: CLdata2 + end type + + end module results3 + +program driver + use results3 + integer i + do i=1, 2 + call test() + end do + + contains + + subroutine test + implicit none + class(CAMBdata2), pointer :: Data + + allocate(CAMBdata2::Data) + + allocate(Data%ClData2%CTransScal%Delta_p_l_k(3, 1000, 1000)) + allocate(Data%ClData2%CTransVec%Delta_p_l_k(3, 1000, 1000)) + deallocate(Data) + + end subroutine test + + end program driver + +!{ dg-final { cleanup-modules "miscutils results3" } } +