public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7181] Fortran: Fix an excess finalization during allocation [PR104272]
@ 2023-04-14 10:15 Paul Thomas
0 siblings, 0 replies; only message in thread
From: Paul Thomas @ 2023-04-14 10:15 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:b0e85485fbf042abccee5c0a9eb499da386c8db3
commit r13-7181-gb0e85485fbf042abccee5c0a9eb499da386c8db3
Author: Paul Thomas <pault@gcc.gnu.org>
Date: Fri Apr 14 11:14:00 2023 +0100
Fortran: Fix an excess finalization during allocation [PR104272]
2023-04-14 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/104272
* gfortran.h : Add expr3_not_explicit bit field to gfc_code.
* resolve.cc (resolve_allocate_expr): Set bit field when the
default initializer is applied to expr3.
* trans-stmt.cc (gfc_trans_allocate): If expr3_not_explicit is
set, do not deallocate expr3.
gcc/testsuite/
PR fortran/104272
* gfortran.dg/class_result_8.f90 : Number of builtin_frees down
from 6 to 5 without memory leaks.
* gfortran.dg/finalize_52.f90: New test
Diff:
---
gcc/fortran/gfortran.h | 2 +
gcc/fortran/resolve.cc | 3 ++
gcc/fortran/trans-stmt.cc | 7 +++-
gcc/testsuite/gfortran.dg/class_result_8.f90 | 2 +-
gcc/testsuite/gfortran.dg/finalize_52.f90 | 57 ++++++++++++++++++++++++++++
5 files changed, 68 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 130d5d7e5b7..db77d24e8b5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3005,6 +3005,8 @@ typedef struct gfc_code
/* Take the array specification from expr3 to allocate arrays
without an explicit array specification. */
unsigned arr_spec_from_expr3:1;
+ /* expr3 is not explicit */
+ unsigned expr3_not_explicit:1;
}
alloc;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 58013d48dff..55d8e326a87 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8089,6 +8089,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
if (!t)
goto failure;
+ code->ext.alloc.expr3_not_explicit = 0;
if (e->ts.type == BT_CLASS && CLASS_DATA (e)->attr.dimension
&& !code->expr3 && code->ext.alloc.ts.type == BT_DERIVED)
{
@@ -8097,6 +8098,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
when the allocated type is different from the declared type but
no SOURCE exists by setting expr3. */
code->expr3 = gfc_default_initializer (&code->ext.alloc.ts);
+ code->ext.alloc.expr3_not_explicit = 1;
}
else if (flag_coarray != GFC_FCOARRAY_LIB && e->ts.type == BT_DERIVED
&& e->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
@@ -8104,6 +8106,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
{
/* We have to zero initialize the integer variable. */
code->expr3 = gfc_get_int_expr (gfc_default_integer_kind, &e->where, 0);
+ code->ext.alloc.expr3_not_explicit = 1;
}
if (e->ts.type == BT_CLASS && !unlimited && !UNLIMITED_POLY (code->expr3))
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f78875455a5..776f98d08d9 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6458,12 +6458,15 @@ gfc_trans_allocate (gfc_code * code)
/* Deallocate any allocatable components in expressions that use a
temporary object, i.e. are not a simple alias of to an EXPR_VARIABLE.
E.g. temporaries of a function call need freeing of their components
- here. */
+ here. Explicit derived type allocation of class entities uses expr3
+ to carry the default initializer. This must not be deallocated or
+ finalized. */
if ((code->expr3->ts.type == BT_DERIVED
|| code->expr3->ts.type == BT_CLASS)
&& (code->expr3->expr_type != EXPR_VARIABLE || temp_obj_created)
&& code->expr3->ts.u.derived->attr.alloc_comp
- && !code->expr3->must_finalize)
+ && !code->expr3->must_finalize
+ && !code->ext.alloc.expr3_not_explicit)
{
tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,
expr3, code->expr3->rank);
diff --git a/gcc/testsuite/gfortran.dg/class_result_8.f90 b/gcc/testsuite/gfortran.dg/class_result_8.f90
index 573dd44daad..9a1fb2ba50f 100644
--- a/gcc/testsuite/gfortran.dg/class_result_8.f90
+++ b/gcc/testsuite/gfortran.dg/class_result_8.f90
@@ -37,5 +37,5 @@ program polymorphic_operators_memory_leaks
call assign_a_type (a, add_a_type(a,b))
print *, a%x
end
-! { dg-final { scan-tree-dump-times "builtin_free" 6 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 5 "original" } }
! { dg-final { scan-tree-dump-times "builtin_malloc" 7 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_52.f90 b/gcc/testsuite/gfortran.dg/finalize_52.f90
new file mode 100644
index 00000000000..be2ca1715f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_52.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+!
+! Test the fix for PR104272 in which allocate caused an unwanted finalization
+!
+! Contributed by Kai Germaschewski <kai.germaschewski@gmail.com>
+!
+module solver_m
+ implicit none
+
+ type, abstract, public :: solver_base_t
+ end type solver_base_t
+
+ type, public, extends(solver_base_t) :: solver_gpu_t
+ complex, dimension(:), allocatable :: x
+ contains
+ final :: solver_gpu_final
+ end type solver_gpu_t
+
+ type, public, extends(solver_gpu_t) :: solver_sparse_gpu_t
+ contains
+ final :: solver_sparse_gpu_final
+ end type solver_sparse_gpu_t
+
+ integer :: final_counts = 0
+
+ contains
+
+ impure elemental subroutine solver_gpu_final(this)
+ type(solver_gpu_t), intent(INOUT) :: this
+ final_counts = final_counts + 1
+ end subroutine solver_gpu_final
+
+ impure elemental subroutine solver_sparse_gpu_final(this)
+ type(solver_sparse_gpu_t), intent(INOUT) :: this
+ final_counts = final_counts + 10
+ end subroutine solver_sparse_gpu_final
+
+ end module solver_m
+
+ subroutine test
+ use solver_m
+ implicit none
+
+ class(solver_base_t), dimension(:), allocatable :: solver
+
+ allocate(solver_sparse_gpu_t :: solver(2))
+
+ if (final_counts .ne. 0) stop 1
+ end subroutine
+
+program main
+ use solver_m
+ implicit none
+
+ call test
+ if (final_counts .ne. 22) stop 2 ! Scalar finalizers for rank 1/size 2
+end program
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-04-14 10:15 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-04-14 10:15 [gcc r13-7181] Fortran: Fix an excess finalization during allocation [PR104272] Paul Thomas
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).