Hi,
Antony Lewis reported this issue and also proposed a patch, that removes the
was_finalized tracking. While this may lead to the desired effect for the issue
at hand, I don't believe that the was_finalized tracking code has been there for
no reason.
This patch fixes the issue that also Antony found, but by ensuring the
expression stays allocated when used instead of being freeed.
The test has been put into the asan directory of gfortran.dg and reliably
reports the issue without the fix. (With the fix, the asan is quite).
Regtests ok on x86_64-pc-linxu-gnu / F41. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 2c7c6a6db78c448a158ee4f952cf2236665001ca Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Wed, 25 Jun 2025 14:46:16 +0200
Subject: [PATCH] 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/finalizer_1.f90: New test.
---
gcc/fortran/class.cc | 24 ++++---
.../gfortran.dg/asan/finalizer_1.f90 | 67 +++++++++++++++++++
2 files changed, 81 insertions(+), 10 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/asan/finalizer_1.f90
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index df18601e45b..a1c6fafa75e 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/finalizer_1.f90 b/gcc/testsuite/gfortran.dg/asan/finalizer_1.f90
new file mode 100644
index 00000000000..dfc20de7f3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/finalizer_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" } }
+
--
2.49.0
