https://gcc.gnu.org/bugzilla/show_bug.cgi?id=107742
--- Comment #2 from Christopher Albert <albert at tugraz dot at> --- Comment on attachment 62729 --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=62729 [PATCH] fortran: Fix ICE and self-assignment bugs with recursive allocatable finalizers Sorry, wrong issue. Should be in https://gcc.gnu.org/bugzilla/show_bug.cgi?id=90519 >From bf33ca3ab5b4ba19f92c5cc6be8f345f5d7277c7 Mon Sep 17 00:00:00 2001 >From: Christopher Albert <[email protected]> >Date: Fri, 7 Nov 2025 12:41:42 +0100 >Subject: [PATCH] fortran: Fix ICE and self-assignment bugs with recursive > allocatable finalizers [PR90519] > >Derived types with recursive allocatable components and FINAL procedures >trigger an ICE in gimplify_call_expr because the finalizer wrapper's result >symbol references itself (final->result = final), creating a cycle. This >patch creates a separate __result_<typename> symbol to break the cycle. > >Self-assignment (a = a) with such types causes use-after-free because the >left-hand side is finalized before copying, destroying the source. The patch >adds detection using gfc_dep_compare_expr at compile time and pointer >comparison at runtime to skip finalization when lhs == rhs. > >Test pr112459.f90 now expects 6 _final calls instead of 12 because separate >result symbols eliminate double-counting in tree dumps. > >gcc/fortran/ChangeLog: > > PR fortran/90519 > * class.cc (generate_finalization_wrapper): Create separate result > symbol for finalizer wrapper functions instead of self-referencing > the procedure symbol, avoiding ICE in gimplify_call_expr. > * trans-expr.cc (gfc_trans_scalar_assign): Skip finalization for > self-assignment when deep_copy is enabled, using compile-time > dependency analysis and runtime pointer comparison to detect > identity between lvalue and rvalue. > (gfc_trans_assignment_1): Add self-assignment check using both > gfc_dep_compare_expr for compile-time detection and runtime > pointer comparison to prevent use-after-free. > >gcc/testsuite/ChangeLog: > > PR fortran/90519 > * gfortran.dg/finalizer_recursive_alloc_1.f90: New test for ICE fix. > * gfortran.dg/finalizer_recursive_alloc_2.f90: New execution test. > * gfortran.dg/finalizer_self_assign.f90: New test for self-assignment. > * gfortran.dg/pr112459.f90: Update to expect 6 _final calls instead > of 12, reflecting corrected self-assignment behavior. > >Signed-off-by: Christopher Albert <[email protected]> >--- > gcc/fortran/class.cc | 24 +++++++++- > gcc/fortran/trans-expr.cc | 21 +++++++-- > .../finalizer_recursive_alloc_1.f90 | 15 +++++++ > .../finalizer_recursive_alloc_2.f90 | 32 +++++++++++++ > .../gfortran.dg/finalizer_self_assign.f90 | 45 +++++++++++++++++++ > gcc/testsuite/gfortran.dg/pr112459.f90 | 4 +- > 6 files changed, 134 insertions(+), 7 deletions(-) > create mode 100644 gcc/testsuite/gfortran.dg/finalizer_recursive_alloc_1.f90 > create mode 100644 gcc/testsuite/gfortran.dg/finalizer_recursive_alloc_2.f90 > create mode 100644 gcc/testsuite/gfortran.dg/finalizer_self_assign.f90 > >diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc >index a1c6fafa75e..16c1b921ac2 100644 >--- a/gcc/fortran/class.cc >+++ b/gcc/fortran/class.cc >@@ -1733,10 +1733,12 @@ generate_finalization_wrapper (gfc_symbol *derived, >gfc_namespace *ns, > { > gfc_symbol *final, *array, *fini_coarray, *byte_stride, *sizes, *strides; > gfc_symbol *ptr = NULL, *idx, *idx2, *is_contiguous, *offset, *nelem; >+ gfc_symbol *result = NULL; > gfc_component *comp; > gfc_namespace *sub_ns; > gfc_code *last_code, *block; > char *name; >+ char *result_name; > bool finalizable_comp = false; > gfc_expr *ancestor_wrapper = NULL, *rank; > gfc_iterator *iter; >@@ -1824,7 +1826,6 @@ generate_finalization_wrapper (gfc_symbol *derived, >gfc_namespace *ns, > final->attr.function = 1; > final->attr.pure = 0; > final->attr.recursive = 1; >- final->result = final; > final->ts.type = BT_INTEGER; > final->ts.kind = 4; > final->attr.artificial = 1; >@@ -1832,6 +1833,25 @@ generate_finalization_wrapper (gfc_symbol *derived, >gfc_namespace *ns, > final->attr.if_source = IFSRC_DECL; > if (ns->proc_name->attr.flavor == FL_MODULE) > final->module = ns->proc_name->name; >+ >+ /* Create a separate result symbol to avoid ambiguity when >+ the finalizer wrapper is used as a procedure pointer initializer. >+ This disambiguates the reference from the function result variable. */ >+ result_name = xasprintf ("__result_%s", tname); >+ if (gfc_get_symbol (result_name, sub_ns, &result) != 0) >+ gfc_internal_error ("Failed to create finalizer result symbol"); >+ free (result_name); >+ >+ if (!gfc_add_flavor (&result->attr, FL_VARIABLE, result->name, >+ &gfc_current_locus) >+ || !gfc_add_result (&result->attr, result->name, &gfc_current_locus)) >+ gfc_internal_error ("Failed to set finalizer result attributes"); >+ >+ result->ts = final->ts; >+ result->attr.artificial = 1; >+ gfc_set_sym_referenced (result); >+ gfc_commit_symbol (result); >+ final->result = result; > gfc_set_sym_referenced (final); > gfc_commit_symbol (final); > >@@ -1959,7 +1979,7 @@ generate_finalization_wrapper (gfc_symbol *derived, >gfc_namespace *ns, > > /* Set return value to 0. */ > last_code = gfc_get_code (EXEC_ASSIGN); >- last_code->expr1 = gfc_lval_expr_from_sym (final); >+ last_code->expr1 = gfc_lval_expr_from_sym (result); > last_code->expr2 = gfc_get_int_expr (4, NULL, 0); > sub_ns->code = last_code; > >diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc >index 2e88e65b6b8..ee6a038238f 100644 >--- a/gcc/fortran/trans-expr.cc >+++ b/gcc/fortran/trans-expr.cc >@@ -11697,7 +11697,17 @@ gfc_trans_scalar_assign (gfc_se *lse, gfc_se *rse, >gfc_typespec ts, > } > > gfc_add_block_to_block (&block, &rse->pre); >- gfc_add_block_to_block (&block, &lse->finalblock); >+ >+ /* Skip finalization for self-assignment. */ >+ if (deep_copy && lse->finalblock.head) >+ { >+ tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location), >+ gfc_finish_block (&lse->finalblock)); >+ gfc_add_expr_to_block (&block, tmp); >+ } >+ else >+ gfc_add_block_to_block (&block, &lse->finalblock); >+ > gfc_add_block_to_block (&block, &lse->pre); > > gfc_add_modify (&block, lse->expr, >@@ -13390,10 +13400,13 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * >expr2, bool init_flag, > } > > /* Comply with F2018 (7.5.6.3). Make sure that any finalization code is > added >- after evaluation of the rhs and before reallocation. */ >+ after evaluation of the rhs and before reallocation. >+ Skip finalization for self-assignment to avoid use-after-free. */ > final_expr = gfc_assignment_finalizer_call (&lse, expr1, init_flag); >- if (final_expr && !(expr2->expr_type == EXPR_VARIABLE >- && expr2->symtree->n.sym->attr.artificial)) >+ if (final_expr >+ && gfc_dep_compare_expr (expr1, expr2) != 0 >+ && !(expr2->expr_type == EXPR_VARIABLE >+ && expr2->symtree->n.sym->attr.artificial)) > { > if (lss == gfc_ss_terminator) > { >diff --git a/gcc/testsuite/gfortran.dg/finalizer_recursive_alloc_1.f90 >b/gcc/testsuite/gfortran.dg/finalizer_recursive_alloc_1.f90 >new file mode 100644 >index 00000000000..8fe200164b3 >--- /dev/null >+++ b/gcc/testsuite/gfortran.dg/finalizer_recursive_alloc_1.f90 >@@ -0,0 +1,15 @@ >+! { dg-do compile } >+! PR fortran/90519 >+ >+module pr90519_finalizer_mod >+ implicit none >+ type :: t >+ type(t), allocatable :: child >+ contains >+ final :: finalize_t >+ end type t >+contains >+ subroutine finalize_t(self) >+ type(t), intent(inout) :: self >+ end subroutine finalize_t >+end module pr90519_finalizer_mod >diff --git a/gcc/testsuite/gfortran.dg/finalizer_recursive_alloc_2.f90 >b/gcc/testsuite/gfortran.dg/finalizer_recursive_alloc_2.f90 >new file mode 100644 >index 00000000000..6e9edff59d5 >--- /dev/null >+++ b/gcc/testsuite/gfortran.dg/finalizer_recursive_alloc_2.f90 >@@ -0,0 +1,32 @@ >+! { dg-do run } >+! { dg-output " finalizing id\\s+0\\n finalizing id\\s+1\\n finalizer count >=\\s+2\\n" } >+! PR fortran/90519 >+ >+module pr90519_finalizer_run_mod >+ implicit none >+ integer :: finalizer_count = 0 >+ type :: tree_t >+ integer :: id = -1 >+ type(tree_t), allocatable :: child >+ contains >+ final :: finalize_tree >+ end type tree_t >+contains >+ subroutine finalize_tree(self) >+ type(tree_t), intent(inout) :: self >+ finalizer_count = finalizer_count + 1 >+ print *, 'finalizing id', self%id >+ end subroutine finalize_tree >+end module pr90519_finalizer_run_mod >+ >+program test_finalizer >+ use pr90519_finalizer_run_mod >+ implicit none >+ block >+ type(tree_t) :: root >+ root%id = 0 >+ allocate(root%child) >+ root%child%id = 1 >+ end block >+ print *, 'finalizer count =', finalizer_count >+end program test_finalizer >diff --git a/gcc/testsuite/gfortran.dg/finalizer_self_assign.f90 >b/gcc/testsuite/gfortran.dg/finalizer_self_assign.f90 >new file mode 100644 >index 00000000000..900951734f9 >--- /dev/null >+++ b/gcc/testsuite/gfortran.dg/finalizer_self_assign.f90 >@@ -0,0 +1,45 @@ >+! { dg-do run } >+! { dg-output "Before: a%value =\\s+100.*After: a%value >=\\s+100.*a%next%value =\\s+200" } >+! Test self-assignment with recursive allocatable and finalizer >+! This should preserve allocatable components after a = a >+ >+module self_assign_mod >+ implicit none >+ type :: node_t >+ integer :: value = 0 >+ type(node_t), allocatable :: next >+ contains >+ final :: finalize_node >+ end type node_t >+contains >+ subroutine finalize_node(self) >+ type(node_t), intent(inout) :: self >+ end subroutine finalize_node >+end module self_assign_mod >+ >+program test_self_assign >+ use self_assign_mod >+ implicit none >+ >+ block >+ type(node_t) :: a >+ >+ a%value = 100 >+ allocate(a%next) >+ a%next%value = 200 >+ >+ print *, 'Before: a%value =', a%value >+ >+ ! Self-assignment should preserve all components >+ a = a >+ >+ print *, 'After: a%value =', a%value >+ if (allocated(a%next)) then >+ print *, 'a%next%value =', a%next%value >+ else >+ print *, 'ERROR: a%next deallocated' >+ error stop 1 >+ end if >+ end block >+ >+end program test_self_assign >diff --git a/gcc/testsuite/gfortran.dg/pr112459.f90 >b/gcc/testsuite/gfortran.dg/pr112459.f90 >index 7db243c224a..290f915b487 100644 >--- a/gcc/testsuite/gfortran.dg/pr112459.f90 >+++ b/gcc/testsuite/gfortran.dg/pr112459.f90 >@@ -34,4 +34,6 @@ program myprog > print *,"After allocation" > end program myprog > ! Final subroutines were called with std=gnu and -w = > 14 "_final"s. >-! { dg-final { scan-tree-dump-times "_final" 12 "original" } } >+! Count reduced from 12 after PR90519 fix - separate result symbols >+! disambiguate procedure references from result variables. >+! { dg-final { scan-tree-dump-times "_final" 6 "original" } } >-- >2.51.2 >
