[Patch, Fortran] 0/3 (PR90076) Setting _vptr correctly.
Hi GFortraneers, I like to present a small series of patches. While working of PR90076 and figuring how to best set the _vptr of class types, I discovered several ways of doing this in slightly different ways which are more or less complete (mostly rather less). I therefore decided to fix not only the PR90076, but also to approach the issue in a more general way. This results in these three patches: 1/3 Fix PR90076 by applying gfc_set_vptr() where missing. 2/3 Rigorously apply gfc_set_vptr() (and extend it slightly) to reset the _vptr consistently. 3/3 RFC: First step on assigning to the _vptr. Working on the second part of the patch series, I figured, that at several locations in the fortran compiler we are assigning to class data types and each location does it differently (more or less complete). Therefore I got the idea of creating a general function to do all necessary steps for assigning to a class data type, like for example `gfc_add_modify_class (gfc_se *, tree to, from)`. The gfc_se is chosen to be able to produce a `pre` and `post` set of statements, while the _data assignment is done in the `expr` to be able to use gfc_add_modify_class() by the scalarizer. I understand that this is long way to go. Therefore I first like to ask about the general perception of this idea. So I like to hear constructive criticism. Could I explain it good enough? Do you think it is worth pursuing? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de
[Patch, Fortran] 2/3 Refactor locations where _vptr is (re)set.
Hi all,
this patch refactors most of the locations where the _vptr of a class data type
is reset. The code was inconsistent in most of the locations. The goal of using
only one routine for setting the _vptr is to be able to later modify it more
easily.
The ultimate goal being that every time one assigns to a class data type a
consistent way is used to prevent forgetting the corner cases. So this is just a
small step in this direction. I think it is worth to simplify the code to
something consistent to reduce maintenance efforts anyhow.
Regtested ok on x86_64 Fedora 39. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From f9018fa7d4dc752331e62963c9cf86ab01a1bfc5 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Fri, 7 Jun 2024 08:57:36 +0200
Subject: [PATCH 2/3] Use gfc_reset_vptr more consistently.
The vptr for a class type is set in various ways in different
locations. Refactor the use and simplify code.
gcc/fortran/ChangeLog:
* trans-array.cc (structure_alloc_comps): Use reset_vptr.
* trans-decl.cc (gfc_trans_deferred_vars): Same.
(gfc_generate_function_code): Same.
* trans-expr.cc (gfc_reset_vptr): Allow supplying the class
type.
(gfc_conv_procedure_call): Use reset_vptr.
* trans-intrinsic.cc (gfc_conv_intrinsic_transfer): Same.
---
gcc/fortran/trans-array.cc | 34
gcc/fortran/trans-decl.cc | 19 ++--
gcc/fortran/trans-expr.cc | 57 +-
gcc/fortran/trans-intrinsic.cc | 10 +-
4 files changed, 38 insertions(+), 82 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cc50b961a97..b3088a892c8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9864,15 +9864,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
else
{
/* Build the vtable address and set the vptr with it. */
- tree vtab;
- gfc_symbol *vtable;
- vtable = gfc_find_derived_vtab (c->ts.u.derived);
- vtab = vtable->backend_decl;
- if (vtab == NULL_TREE)
- vtab = gfc_get_symbol_decl (vtable);
- vtab = gfc_build_addr_expr (NULL, vtab);
- vtab = fold_convert (TREE_TYPE (tmp), vtab);
- gfc_add_modify (&tmpblock, tmp, vtab);
+ gfc_reset_vptr (&tmpblock, nullptr, tmp, c->ts.u.derived);
}
}
@@ -9903,15 +9895,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
&& (CLASS_DATA (c)->attr.allocatable
|| CLASS_DATA (c)->attr.class_pointer))
{
- tree vptr_decl;
+ tree class_ref;
/* Allocatable CLASS components. */
- comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
- decl, cdecl, NULL_TREE);
-
- vptr_decl = gfc_class_vptr_get (comp);
+ class_ref = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+ decl, cdecl, NULL_TREE);
- comp = gfc_class_data_get (comp);
+ comp = gfc_class_data_get (class_ref);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
gfc_conv_descriptor_data_set (&fnblock, comp,
null_pointer_node);
@@ -9926,19 +9916,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
/* The dynamic type of a disassociated pointer or unallocated
allocatable variable is its declared type. An unlimited
polymorphic entity has no declared type. */
- if (!UNLIMITED_POLY (c))
- {
- vtab = gfc_find_derived_vtab (c->ts.u.derived);
- if (!vtab->backend_decl)
- gfc_get_symbol_decl (vtab);
- tmp = gfc_build_addr_expr (NULL_TREE, vtab->backend_decl);
- }
- else
- tmp = build_int_cst (TREE_TYPE (vptr_decl), 0);
-
- tmp = fold_build2_loc (input_location, MODIFY_EXPR,
- void_type_node, vptr_decl, tmp);
- gfc_add_expr_to_block (&fnblock, tmp);
+ gfc_reset_vptr (&fnblock, nullptr, class_ref, c->ts.u.derived);
cmp_has_alloc_comps = false;
}
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 88538713a02..1786f80245f 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5070,26 +5070,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (sym->ts.type == BT_CLASS)
{
/* Initialize _vptr to declared type. */
- gfc_symbol *vtab;
- tree rhs;
-
gfc_save_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
e = gfc_lval_expr_from_sym (sym);
- gfc_add_vptr_component (e);
- gfc_init_se (&se, NULL);
- se.want_pointer = 1;
- gfc_conv_expr (&se, e);
+ gfc_reset_vptr (&init, e);
gfc_free_expr (e);
- if (UNLIMITED_POLY (sym))
- rhs = build_int_cst (TREE_TYPE (se.expr), 0);
- else
- {
- vtab = gfc_find_derived_vtab (sym->ts.u.derived);
- rhs = gfc_build_addr_expr (TREE_TYPE (se.expr),
- gfc_get_symbol_decl (vtab));
- }
- gfc_add_modify (&init, se.expr, rhs);
gfc_restore_backend_locus (&loc
[Patch, Fortran, 90076] 1/3 Fix Polymorphic Allocate on Assignment Memory Leak
Hi all,
the attached patch fix the last case in the bug report. The inital example code
is already fixed by the combination of PR90068 and PR90072. The issue was the
_vptr was not (re)set correctly, like in the __vtab_...-structure was not
created. This made the compiler ICE.
Regtests fine on x86_64 Fedora 39. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From e3a7f07e7dfad7ab347f148d2d46b633c0bbdecc Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Thu, 6 Jun 2024 14:01:13 +0200
Subject: [PATCH 1/3] 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/cla
[Patch, Fortran] 3/3 RFC: Introduce gfc_class_set_vptr.
Hi all,
although this mail has a patch attached, it is rather a request for comment. The
attached patch introduces `gfc_class_set_vptr()` for consistently assigning the
_vptr of a class data type. I figured that gfortran does these assignments in
various locations and does them differently everywhere without any obvious
needs. During working on this I got the impression that it could be worth to add
a general class assignment function and this could be the first step to it. The
final goal is to reduce the complexity of assigning to class data types and to
prevent forgetting the corner cases. What do you think?
On x86_66 Fedora 39 this regtests fine.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 9847eaa6aa96eead01ab26800812bc5aeb6443d2 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Tue, 11 Jun 2024 12:52:26 +0200
Subject: [PATCH 3/3] Add gfc_class_set_vptr.
First step to adding a general assign all class type's data members
routine. Having a general routine prevents forgetting to tackle the
edge cases, e.g. setting _len.
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_class_set_vptr): Add setting of _vptr
member.
* trans-intrinsic.cc (conv_intrinsic_move_alloc): First use
of gfc_class_set_vptr and refactor very similar code.
* trans.h (gfc_class_set_vptr): Declare the new function.
gcc/testsuite/ChangeLog:
* gfortran.dg/unlimited_polymorphic_11.f90: Remove unnecessary
casts in gd-final expression.
---
gcc/fortran/trans-expr.cc | 44
gcc/fortran/trans-intrinsic.cc| 203 +-
gcc/fortran/trans.h | 2 +
.../gfortran.dg/unlimited_polymorphic_11.f90 | 2 +-
4 files changed, 106 insertions(+), 145 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 454b87581f5..0796fb75505 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -598,6 +598,50 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container,
}
}
+void
+gfc_class_set_vptr (stmtblock_t *block, tree to, tree from)
+{
+ tree tmp, vptr_ref;
+ // gcc_assert (POINTER_TYPE_P (TREE_TYPE (to))
+ // && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_TYPE (to;
+ vptr_ref = gfc_get_vptr_from_expr (to);
+ if (POINTER_TYPE_P (TREE_TYPE (from))
+ && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_TYPE (from
+{
+ gfc_add_modify (block, vptr_ref,
+ fold_convert (TREE_TYPE (vptr_ref),
+gfc_get_vptr_from_expr (from)));
+}
+ else if (VAR_P (from)
+ && strncmp (IDENTIFIER_POINTER (DECL_NAME (from)), "__vtab", 6) == 0)
+{
+ gfc_add_modify (block, vptr_ref,
+ gfc_build_addr_expr (TREE_TYPE (vptr_ref), from));
+}
+ else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (from)))
+ && GFC_CLASS_TYPE_P (
+ TREE_TYPE (TREE_OPERAND (TREE_OPERAND (from, 0), 0
+{
+ gfc_add_modify (block, vptr_ref,
+ fold_convert (TREE_TYPE (vptr_ref),
+gfc_get_vptr_from_expr (TREE_OPERAND (
+ TREE_OPERAND (from, 0), 0;
+}
+ else
+{
+ tree vtab;
+ gfc_symbol *type;
+ tmp = TREE_TYPE (from);
+ if (POINTER_TYPE_P (tmp))
+ tmp = TREE_TYPE (tmp);
+ gfc_find_symbol (IDENTIFIER_POINTER (TYPE_NAME (tmp)), gfc_current_ns, 1,
+ &type);
+ vtab = gfc_find_derived_vtab (type)->backend_decl;
+ gcc_assert (vtab);
+ gfc_add_modify (block, vptr_ref,
+ gfc_build_addr_expr (TREE_TYPE (vptr_ref), vtab));
+}
+}
/* Reset the len for unlimited polymorphic objects. */
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index ac7fcd250d3..5ea10e84060 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -12667,10 +12667,9 @@ conv_intrinsic_move_alloc (gfc_code *code)
{
stmtblock_t block;
gfc_expr *from_expr, *to_expr;
- gfc_expr *to_expr2, *from_expr2 = NULL;
gfc_se from_se, to_se;
- tree tmp;
- bool coarray;
+ tree tmp, to_tree, from_tree;
+ bool coarray, from_is_class, from_is_scalar;
gfc_start_block (&block);
@@ -12680,178 +12679,94 @@ conv_intrinsic_move_alloc (gfc_code *code)
gfc_init_se (&from_se, NULL);
gfc_init_se (&to_se, NULL);
- gcc_assert (from_expr->ts.type != BT_CLASS
- || to_expr->ts.type == BT_CLASS);
+ gcc_assert (from_expr->ts.type != BT_CLASS || to_expr->ts.type == BT_CLASS);
coarray = gfc_get_corank (from_expr) != 0;
- if (from_expr->rank == 0 && !coarray)
+ from_is_class = from_expr->ts.type == BT_CLASS;
+ from_is_scalar = from_expr->rank == 0 && !coarray;
+ if (to_expr->ts.type == BT_CLASS || from_is_scalar)
{
- if (from_expr->ts.type != BT_CLASS)
- from_expr2 = from_expr;
+ from_se.want_pointer = 1;
+ if (from_is_scalar)
+ gfc_conv_expr (&from_se, from_expr);
else
- {
- from_expr2 = gfc_copy_expr (from_expr);
- gfc_add_data_component (from_expr2);
- }
-
- if (to_expr->ts.type != BT_CLASS)
- to_exp
[Patch, Fortran, 96418] Fix Test coarray_alloc_comp_4.f08 ICEs
Hi all,
attached patch has already been present in 2020, but lost my attention. It
fixes an ICE in the testsuite. The old mails description is:
attached patch fixes PR96418 where the code in the testsuite when compiled with
-fcoarray=single lead to an ICE. The reason was that the coarray object was
derefed as an array, but it was no array. Introducing the test for the
descriptor removes the ICE.
Regtests ok on x86_64-linux/Fedora 39. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From e56f32ed836c1ecc2b46497d1d7b9c7c08749521 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Tue, 11 Jun 2024 15:24:55 +0200
Subject: [PATCH] Fix ICE when compiling with -fcoarray=single, when derefing a
non-array.
PR fortran/96418
gcc/fortran/ChangeLog:
* trans.c (gfc_deallocate_with_status): Check that object to deref
is an array, before applying array deref.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray_alloc_comp_3.f08: Moved to...
* gfortran.dg/coarray/alloc_comp_6.f90: ...here.
Should be tested for both -fcoarray=single and lib, resp.
* gfortran.dg/coarray_alloc_comp_4.f08: Fix program name.
---
gcc/fortran/trans.cc | 3 ++-
.../{coarray_alloc_comp_3.f08 => coarray/alloc_comp_6.f08} | 3 +--
gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 | 2 +-
3 files changed, 4 insertions(+), 4 deletions(-)
rename gcc/testsuite/gfortran.dg/{coarray_alloc_comp_3.f08 => coarray/alloc_comp_6.f08} (95%)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index a208afe90ab..1335b8cc48b 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1838,7 +1838,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
else
caf_dereg_type = (enum gfc_coarray_deregtype) coarray_dealloc_mode;
}
- else if (flag_coarray == GFC_FCOARRAY_SINGLE)
+ else if (flag_coarray == GFC_FCOARRAY_SINGLE
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer)))
pointer = gfc_conv_descriptor_data_get (pointer);
}
else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer)))
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_6.f08
similarity index 95%
rename from gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08
rename to gcc/testsuite/gfortran.dg/coarray/alloc_comp_6.f08
index e2037aa5809..8b153925129 100644
--- a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_6.f08
@@ -1,12 +1,11 @@
! { dg-do run }
-! { dg-options "-fcoarray=lib -lcaf_single" }
! { dg-additional-options "-latomic" { target libatomic_available } }
!
! Contributed by Andre Vehreschild
! Check that manually freeing components does not lead to a runtime crash,
! when the auto-deallocation is taking care.
-program coarray_alloc_comp_3
+program alloc_comp_6
implicit none
type dt
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08
index 6586ec651dd..4c71a90af8f 100644
--- a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08
@@ -5,7 +5,7 @@
! Contributed by Andre Vehreschild
! Check that sub-components are caf_deregistered and not freed.
-program coarray_alloc_comp_3
+program coarray_alloc_comp_4
implicit none
type dt
--
2.45.1
