]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Ensure finalizer is called for unreferenced variable [PR118730]
authorAndre Vehreschild <vehre@gcc.gnu.org>
Thu, 27 Feb 2025 11:27:10 +0000 (12:27 +0100)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Fri, 28 Feb 2025 09:08:57 +0000 (10:08 +0100)
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
gcc/testsuite/gfortran.dg/class_array_15.f03
gcc/testsuite/gfortran.dg/coarray_poly_7.f90
gcc/testsuite/gfortran.dg/coarray_poly_8.f90
gcc/testsuite/gfortran.dg/finalize_60.f90 [new file with mode: 0644]

index 6a83a7967a8bb3d238717be7969c29e68017e31d..f83d122a3a2185f34f2b209a0966fb0c19fafb2c 100644 (file)
@@ -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;
 
index 332b39833ebf5d91b2e3bbad8db63fca197d7550..f53b2356952a0b2e4e5261167a8cc08192e33f65 100644 (file)
@@ -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
index d8d83aea39b58c6dec022f36ff5514c2691463e7..21a3054f59c93e5feb8a9bcd266bf733454912c8 100644 (file)
@@ -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" } }
index abdfc0ca5f821d0a9d392296323e88ca8eeeec11..9ceece419aeb60607abb92a792818c6e0564205b 100644 (file)
@@ -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 (file)
index 0000000..1ce50b3
--- /dev/null
@@ -0,0 +1,33 @@
+!{ dg-do run }
+!
+! Check that the finalizer is called on unused variables too.
+! Contributed by LXYAN  <z00823823@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