Hi all,
attached patch fixes user defined finalizers in derived (class) types not
getting called, when the variable declared of that type was not used in the
current block. The patch ensures calling the finalizer by marking the
variable referenced, if it has not been.
Additionally I had to patch three testcases, because their tree-dump-scans did
not fit anymore. In one case a variable was not used in the two others the
counts did not match any more.
Regstests ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From e86c918e59b8c1b66ce837c2b4c735204c2d5510 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Thu, 27 Feb 2025 12:27:10 +0100
Subject: [PATCH] Fortran: Ensure finalizer is called for unreferenced variable
[PR118730]
PR fortran/118730
gcc/fortran/ChangeLog:
* resolve.cc: Mark unused derived type variable with finalizers
referenced to execute finalizer when leaving scope.
gcc/testsuite/ChangeLog:
* gfortran.dg/class_array_15.f03: Remove unused variable.
* gfortran.dg/coarray_poly_7.f90: Adapt scan-tree-dump expr.
* gfortran.dg/coarray_poly_8.f90: Same.
* gfortran.dg/finalize_60.f90: New test.
---
gcc/fortran/resolve.cc | 8 +++++
gcc/testsuite/gfortran.dg/class_array_15.f03 | 2 +-
gcc/testsuite/gfortran.dg/coarray_poly_7.f90 | 2 +-
gcc/testsuite/gfortran.dg/coarray_poly_8.f90 | 2 +-
gcc/testsuite/gfortran.dg/finalize_60.f90 | 33 ++++++++++++++++++++
5 files changed, 44 insertions(+), 3 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/finalize_60.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6a83a7967a8..f83d122a3a2 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17063,6 +17063,14 @@ skip_interfaces:
return;
}
+ /* Ensure that variables of derived or class type having a finalizer are
+ marked used even when the variable is not used anything else in the scope.
+ This fixes PR118730. */
+ if (sym->attr.flavor == FL_VARIABLE && !sym->attr.referenced
+ && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
+ && gfc_may_be_finalized (sym->ts))
+ gfc_set_sym_referenced (sym);
+
if (sym->attr.flavor == FL_DERIVED && !resolve_fl_derived (sym))
return;
diff --git a/gcc/testsuite/gfortran.dg/class_array_15.f03 b/gcc/testsuite/gfortran.dg/class_array_15.f03
index 332b39833eb..f53b2356952 100644
--- a/gcc/testsuite/gfortran.dg/class_array_15.f03
+++ b/gcc/testsuite/gfortran.dg/class_array_15.f03
@@ -100,7 +100,7 @@ subroutine pr54992 ! This test remains as the original.
implicit none
type (tn), target :: b
class(ncBh), pointer :: bh
- class(ncBh), allocatable, dimension(:) :: t
+
allocate(b%cBh(1),source=defaultBhC)
b%cBh(1)%hostNode => b
! #1 this worked
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
index d8d83aea39b..21a3054f59c 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
@@ -18,4 +18,4 @@ end
! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.\[0-9\]+, y._data.token, \\(integer\\(kind=\[48\]\\)\\) class.\[0-9\]+._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
index abdfc0ca5f8..9ceece419ae 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
@@ -18,4 +18,4 @@ end
! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.\[0-9\]+, y._data.token, \\(integer\\(kind=\[48\]\\)\\) class.\[0-9\]+._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_60.f90 b/gcc/testsuite/gfortran.dg/finalize_60.f90
new file mode 100644
index 00000000000..1ce50b3a3f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_60.f90
@@ -0,0 +1,33 @@
+!{ dg-do run }
+!
+! Check that the finalizer is called on unused variables too.
+! Contributed by LXYAN <z00823...@outlook.com>
+
+module pr118730_mod
+ implicit none
+
+ logical :: finished = .FALSE.
+
+ type :: test_type
+ integer::test
+ contains
+ final :: finalize
+ end type test_type
+
+contains
+ subroutine finalize(this)
+ type(test_type), intent(inout) :: this
+ finished = .TRUE.
+ end subroutine finalize
+end module pr118730_mod
+
+program pr118730
+ use :: pr118730_mod
+ implicit none
+
+ block
+ type(test_type) :: test
+ end block
+
+ if (.NOT. finished) error stop 1
+end program pr118730
--
2.48.1
