https://gcc.gnu.org/g:c1606e383a3c3abd260dfbb1177637abf05dd9a2
commit r15-7747-gc1606e383a3c3abd260dfbb1177637abf05dd9a2
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Thu Feb 27 12:27:10 2025 +0100
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.
Diff:
---
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(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6a83a7967a8b..f83d122a3a21 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 332b39833ebf..f53b2356952a 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 d8d83aea39b5..21a3054f59c9 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 abdfc0ca5f82..9ceece419aeb 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 000000000000..1ce50b3a3f4f
--- /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
