From dbb718175d7df89b957b316ba2f5fbea5d21b2b1 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Thu, 6 Jun 2024 14:01:13 +0200 Subject: [PATCH] Fortran: Set the vptr of a class typed result. PR fortran/90076 gcc/fortran/ChangeLog: * trans-decl.cc (gfc_generate_function_code): Set vptr for results to declared class type. * trans-expr.cc (gfc_reset_vptr): Allow to provide the typespec instead of the expression. * trans.h (gfc_reset_vptr): Same. gcc/testsuite/ChangeLog: * gfortran.dg/class_76.f90: Add declared vtab occurrence. * gfortran.dg/class_78.f90: New test. --- gcc/fortran/trans-decl.cc | 11 +++++----- gcc/fortran/trans-expr.cc | 10 +++++---- gcc/fortran/trans.h | 4 +++- gcc/testsuite/gfortran.dg/class_76.f90 | 2 +- gcc/testsuite/gfortran.dg/class_78.f90 | 29 ++++++++++++++++++++++++++ 5 files changed, 45 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_78.f90 diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index dca7779528b..88538713a02 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -7926,11 +7926,12 @@ gfc_generate_function_code (gfc_namespace * ns) && CLASS_DATA (sym)->attr.dimension == 0 && sym->result == sym) { - tmp = CLASS_DATA (sym)->backend_decl; - tmp = fold_build3_loc (input_location, COMPONENT_REF, - TREE_TYPE (tmp), result, tmp, NULL_TREE); - gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp), - null_pointer_node)); + tmp = gfc_class_data_get (result); + gfc_add_modify (&init, tmp, + fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + gfc_reset_vptr (&init, nullptr, result, + CLASS_DATA (sym->result)->ts.u.derived); } else if (sym->ts.type == BT_DERIVED && !sym->attr.allocatable) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index d6f4d6bfe45..558a7380516 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -530,13 +530,14 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold, return base_expr; } - /* Reset the vptr to the declared type, e.g. after deallocation. Use the variable in CLASS_CONTAINER if available. Otherwise, recreate - one with E. The generated assignment code is added at the end of BLOCK. */ + one with e or derived. At least one of the two has to be set. The generated + assignment code is added at the end of BLOCK. */ void -gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container) +gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container, + gfc_symbol *derived) { tree vptr = NULL_TREE; @@ -546,6 +547,7 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container) if (vptr == NULL_TREE) { gfc_se se; + gcc_assert (e); /* Evaluate the expression and obtain the vptr from it. */ gfc_init_se (&se, NULL); @@ -570,7 +572,7 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container) tree vtable; /* Return the vptr to the address of the declared type. */ - vtab = gfc_find_derived_vtab (e->ts.u.derived); + vtab = gfc_find_derived_vtab (derived ? derived : e->ts.u.derived); vtable = vtab->backend_decl; if (vtable == NULL_TREE) vtable = gfc_get_symbol_decl (vtab); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index f94fa601400..5e064af5ccb 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -451,7 +451,9 @@ tree gfc_vptr_def_init_get (tree); tree gfc_vptr_copy_get (tree); tree gfc_vptr_final_get (tree); tree gfc_vptr_deallocate_get (tree); -void gfc_reset_vptr (stmtblock_t *, gfc_expr *, tree = NULL_TREE); +void +gfc_reset_vptr (stmtblock_t *, gfc_expr *, tree = NULL_TREE, + gfc_symbol * = nullptr); void gfc_reset_len (stmtblock_t *, gfc_expr *); tree gfc_get_class_from_gfc_expr (gfc_expr *); tree gfc_get_class_from_expr (tree); diff --git a/gcc/testsuite/gfortran.dg/class_76.f90 b/gcc/testsuite/gfortran.dg/class_76.f90 index 1ee1e1fc25f..c9842a15fea 100644 --- a/gcc/testsuite/gfortran.dg/class_76.f90 +++ b/gcc/testsuite/gfortran.dg/class_76.f90 @@ -61,6 +61,6 @@ contains end function newContainer end program returned_memory_leak -! { dg-final { scan-tree-dump-times "newabstract" 14 "original" } } +! { dg-final { scan-tree-dump-times "newabstract" 15 "original" } } ! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } } diff --git a/gcc/testsuite/gfortran.dg/class_78.f90 b/gcc/testsuite/gfortran.dg/class_78.f90 new file mode 100644 index 00000000000..3e2a0245afb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_78.f90 @@ -0,0 +1,29 @@ +! { dg-do run } +! +! PR fortran/90076 +! +! Contributed by Brad Richardson +! + +program assignment_memory_leak + implicit none + + type, abstract :: base + end type base + + type, extends(base) :: extended + end type extended + + call run() +contains + subroutine run() + class(base), allocatable :: var + + var = newVar() ! Crash fixed + end subroutine run + + function newVar() + class(extended), allocatable :: newVar + end function newVar +end program assignment_memory_leak +