[PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]
Hello, the following patches are abot PR110618, a PR similar to PR92178 from which it is cloned. Both are about a problem of dedendencies between arguments, when one of them is associated to an allocatable intent(out) dummy, and thus deallocated in the process of argument association. PR110618 exposes a case where the data reference finalization code for one argument references deallocated data from another argument. The way I propose to fix this is similar to my recent patches for PR92178 [1,2] (and is dependent on them). Those patches try to use a data reference pointer precalculated at the beginning of the process instead of repeatedly evaluating an expression that becomes invalid at some point in the generated code. Unfortunately, the code for finalization is not prepared for this, as it only manipulates front-end expressions, whereas the precalculated pointer is available as middle-end's generic tree. These patches refactor the finalization code to ease the introduction of the forementioned pre-calculated class container pointer. Basically, four expressions are calculated to build the final procedure call: the final procedure pointer, the element size, the data reference (array) descriptor, and (optionally) the virtual table pointer. Each of the four is outlined stepwise to its own separate function in the following patches. This abstracts away the generation of these expressions and makes it easier to add one other way to generate them. This should also make the impact of the changes more visible, and regressions easier to spot. The main changes are the two last patches introducing an additional precalculated pointer argument in relevant functions and using them if set. Details are in the specific patches. Each patch has been bubble-bootstrapped and partially tested with RUNTESTFLAGS="dg.exp=*final*". The complete set has been fully tested on x86_64-pc-linux-gnu. OK for master? [1] https://gcc.gnu.org/pipermail/fortran/2023-July/059582.html [2] https://gcc.gnu.org/pipermail/fortran/2023-July/059583.html Mikael Morin (14): fortran: Outline final procedure pointer evaluation fortran: Outline element size evaluation fortran: Outline data reference descriptor evaluation fortran: Inline gfc_build_final_call fortran: Add missing cleanup blocks fortran: Reuse final procedure pointer expression fortran: Push element size expression generation close to its usage fortran: Push final procedure expr gen close to its one usage. fortran: Inline variable definition fortran: Remove redundant argument in get_var_descr fortran: Outline virtual table pointer evaluation fortran: Factor scalar descriptor generation fortran: Use pre-evaluated class container if available [PR110618] fortran: Pass pre-calculated class container argument [pr110618] gcc/fortran/trans-array.cc | 2 +- gcc/fortran/trans-expr.cc | 7 +- gcc/fortran/trans-stmt.cc | 3 +- gcc/fortran/trans.cc| 314 gcc/fortran/trans.h | 9 +- gcc/testsuite/gfortran.dg/intent_out_22.f90 | 37 +++ 6 files changed, 237 insertions(+), 135 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intent_out_22.f90 -- 2.40.1
[PATCH 02/14] fortran: Outline element size evaluation
gcc/fortran/ChangeLog:
* trans.cc (get_elem_size): New function.
(gfc_build_final_call): Outline the element size evaluation
to get_elem_size.
---
gcc/fortran/trans.cc | 44 ++--
1 file changed, 30 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index b5f7b16eda3..1e4779f94af 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1100,6 +1100,30 @@ get_final_proc_ref (gfc_se *se, gfc_expr *final_wrapper)
}
+/* Generate the code to obtain the value of the element size whose expression
+ is passed as argument in CLASS_SIZE. */
+
+static void
+get_elem_size (gfc_se *se, gfc_typespec *ts, gfc_expr *class_size)
+{
+ gcc_assert (ts->type == BT_DERIVED || ts->type == BT_CLASS);
+
+ if (ts->type == BT_DERIVED)
+{
+ gcc_assert (!class_size);
+ se->expr = gfc_typenode_for_spec (ts);
+ se->expr = TYPE_SIZE_UNIT (se->expr);
+ se->expr = fold_convert (gfc_array_index_type, se->expr);
+}
+ else
+{
+ gcc_assert (class_size);
+ gfc_conv_expr (se, class_size);
+ gcc_assert (se->post.head == NULL_TREE);
+}
+}
+
+
/* Build a call to a FINAL procedure, which finalizes "var". */
static tree
@@ -1107,7 +1131,7 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
bool fini_coarray, gfc_expr *class_size)
{
stmtblock_t block;
- gfc_se final_se;
+ gfc_se final_se, size_se;
gfc_se se;
tree final_fndecl, array, size, tmp;
symbol_attribute attr;
@@ -1121,15 +1145,13 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
gfc_add_block_to_block (&block, &final_se.pre);
final_fndecl = final_se.expr;
+ gfc_init_se (&size_se, NULL);
+ get_elem_size (&size_se, &ts, class_size);
+ gfc_add_block_to_block (&block, &size_se.pre);
+ size = size_se.expr;
+
if (ts.type == BT_DERIVED)
{
- tree elem_size;
-
- gcc_assert (!class_size);
- elem_size = gfc_typenode_for_spec (&ts);
- elem_size = TYPE_SIZE_UNIT (elem_size);
- size = fold_convert (gfc_array_index_type, elem_size);
-
gfc_init_se (&se, NULL);
se.want_pointer = 1;
if (var->rank)
@@ -1155,12 +1177,6 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
else
{
gfc_expr *array_expr;
- gcc_assert (class_size);
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, class_size);
- gfc_add_block_to_block (&block, &se.pre);
- gcc_assert (se.post.head == NULL_TREE);
- size = se.expr;
array_expr = gfc_copy_expr (var);
gfc_init_se (&se, NULL);
--
2.40.1
[PATCH 01/14] fortran: Outline final procedure pointer evaluation
gcc/fortran/ChangeLog:
* trans.cc (get_final_proc_ref): New function.
(gfc_build_final_call): Outline the pointer evaluation code
to get_final_proc_ref.
---
gcc/fortran/trans.cc | 27 +--
1 file changed, 21 insertions(+), 6 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index f1a3aacd850..b5f7b16eda3 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1085,6 +1085,21 @@ gfc_call_free (tree var)
}
+/* Generate the data reference to the finalization procedure pointer passed as
+ argument in FINAL_WRAPPER. */
+
+static void
+get_final_proc_ref (gfc_se *se, gfc_expr *final_wrapper)
+{
+ gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
+
+ gfc_conv_expr (se, final_wrapper);
+
+ if (POINTER_TYPE_P (TREE_TYPE (se->expr)))
+se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+}
+
+
/* Build a call to a FINAL procedure, which finalizes "var". */
static tree
@@ -1092,19 +1107,19 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
bool fini_coarray, gfc_expr *class_size)
{
stmtblock_t block;
+ gfc_se final_se;
gfc_se se;
tree final_fndecl, array, size, tmp;
symbol_attribute attr;
- gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
gcc_assert (var);
gfc_start_block (&block);
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, final_wrapper);
- final_fndecl = se.expr;
- if (POINTER_TYPE_P (TREE_TYPE (final_fndecl)))
-final_fndecl = build_fold_indirect_ref_loc (input_location, final_fndecl);
+
+ gfc_init_se (&final_se, NULL);
+ get_final_proc_ref (&final_se, final_wrapper);
+ gfc_add_block_to_block (&block, &final_se.pre);
+ final_fndecl = final_se.expr;
if (ts.type == BT_DERIVED)
{
--
2.40.1
[PATCH 06/14] fortran: Reuse final procedure pointer expression
Reuse twice the same final procedure pointer expression instead of translating it twice. Final procedure pointer expressions were translated twice, once for the final procedure call, and once for the check for non-nullness (if applicable). gcc/fortran/ChangeLog: * trans.cc (gfc_add_finalizer_call): Move pre and post code for the final procedure pointer expression to the outer block. Reuse the previously evaluated final procedure pointer expression. --- gcc/fortran/trans.cc | 11 +-- 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 5c953a07533..3750d4eca82 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1375,7 +1375,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) gfc_se final_se; gfc_init_se (&final_se, NULL); get_final_proc_ref (&final_se, final_expr); - gfc_add_block_to_block (&tmp_block, &final_se.pre); + gfc_add_block_to_block (block, &final_se.pre); gfc_se size_se; gfc_init_se (&size_se, NULL); @@ -1395,7 +1395,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) gfc_add_block_to_block (&tmp_block, &desc_se.post); gfc_add_block_to_block (&tmp_block, &size_se.post); - gfc_add_block_to_block (&tmp_block, &final_se.post); tmp = gfc_finish_block (&tmp_block); @@ -1404,11 +1403,10 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) tree cond; gfc_se se; - gfc_init_se (&se, NULL); - se.want_pointer = 1; - gfc_conv_expr (&se, final_expr); + tree ptr = gfc_build_addr_expr (NULL_TREE, final_se.expr); + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, - se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); + ptr, build_int_cst (TREE_TYPE (ptr), 0)); /* For CLASS(*) not only sym->_vtab->_final can be NULL but already sym->_vtab itself. */ @@ -1437,6 +1435,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) } gfc_add_expr_to_block (block, tmp); + gfc_add_block_to_block (block, &final_se.post); return true; } -- 2.40.1
[PATCH 07/14] fortran: Push element size expression generation close to its usage
gfc_add_finalizer_call creates one expression which is only used
by the get_final_proc_ref function. Move the expression generation
there.
gcc/fortran/ChangeLog:
* trans.cc (gfc_add_finalizer_call): Remove local variable
elem_size. Pass expression to get_elem_size and move the
element size expression generation close to its usage there.
(get_elem_size): Add argument expr, remove class_size argument
and rebuild it from expr. Remove ts argument and use the
type of expr instead.
---
gcc/fortran/trans.cc | 25 +++--
1 file changed, 11 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 3750d4eca82..e5ad67199e7 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1100,24 +1100,26 @@ get_final_proc_ref (gfc_se *se, gfc_expr *final_wrapper)
}
-/* Generate the code to obtain the value of the element size whose expression
- is passed as argument in CLASS_SIZE. */
+/* Generate the code to obtain the value of the element size of the expression
+ passed as argument in EXPR. */
static void
-get_elem_size (gfc_se *se, gfc_typespec *ts, gfc_expr *class_size)
+get_elem_size (gfc_se *se, gfc_expr *expr)
{
- gcc_assert (ts->type == BT_DERIVED || ts->type == BT_CLASS);
+ gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS);
- if (ts->type == BT_DERIVED)
+ if (expr->ts.type == BT_DERIVED)
{
- gcc_assert (!class_size);
- se->expr = gfc_typenode_for_spec (ts);
+ se->expr = gfc_typenode_for_spec (&expr->ts);
se->expr = TYPE_SIZE_UNIT (se->expr);
se->expr = fold_convert (gfc_array_index_type, se->expr);
}
else
{
- gcc_assert (class_size);
+ gfc_expr *class_size = gfc_copy_expr (expr);
+ gfc_add_vptr_component (class_size);
+ gfc_add_size_component (class_size);
+
gfc_conv_expr (se, class_size);
gcc_assert (se->post.head == NULL_TREE);
}
@@ -1307,7 +1309,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gfc_ref *ref;
gfc_expr *expr;
gfc_expr *final_expr = NULL;
- gfc_expr *elem_size = NULL;
bool has_finalizer = false;
if (!expr2 || (expr2->ts.type != BT_DERIVED && expr2->ts.type != BT_CLASS))
@@ -1361,10 +1362,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
final_expr = gfc_copy_expr (expr);
gfc_add_vptr_component (final_expr);
gfc_add_final_component (final_expr);
-
- elem_size = gfc_copy_expr (expr);
- gfc_add_vptr_component (elem_size);
- gfc_add_size_component (elem_size);
}
gcc_assert (final_expr->expr_type == EXPR_VARIABLE);
@@ -1379,7 +1376,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gfc_se size_se;
gfc_init_se (&size_se, NULL);
- get_elem_size (&size_se, &expr->ts, elem_size);
+ get_elem_size (&size_se, expr);
gfc_add_block_to_block (&tmp_block, &size_se.pre);
gfc_se desc_se;
--
2.40.1
[PATCH 11/14] fortran: Outline virtual table pointer evaluation
gcc/fortran/ChangeLog:
* trans.cc (get_vptr): New function.
(gfc_add_finalizer_call): Move virtual table pointer evaluation
to get_vptr.
---
gcc/fortran/trans.cc | 33 ++---
1 file changed, 22 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index bcf3341fd4b..731dfb626ab 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1214,6 +1214,23 @@ get_var_descr (gfc_se *se, gfc_expr *var)
}
+static void
+get_vptr (gfc_se *se, gfc_expr *expr)
+{
+ gfc_expr *vptr_expr = gfc_copy_expr (expr);
+ gfc_add_vptr_component (vptr_expr);
+
+ gfc_se tmp_se;
+ gfc_init_se (&tmp_se, NULL);
+ tmp_se.want_pointer = 1;
+ gfc_conv_expr (&tmp_se, vptr_expr);
+ gfc_free_expr (vptr_expr);
+
+ gfc_add_block_to_block (&se->pre, &tmp_se.pre);
+ gfc_add_block_to_block (&se->post, &tmp_se.post);
+ se->expr = tmp_se.expr;
+}
+
bool
gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component
*comp,
@@ -1398,7 +1415,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
&& !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
tree cond;
- gfc_se se;
tree ptr = gfc_build_addr_expr (NULL_TREE, final_se.expr);
@@ -1410,19 +1426,14 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
if (UNLIMITED_POLY (expr))
{
tree cond2;
- gfc_expr *vptr_expr;
+ gfc_se vptr_se;
- vptr_expr = gfc_copy_expr (expr);
- gfc_add_vptr_component (vptr_expr);
-
- gfc_init_se (&se, NULL);
- se.want_pointer = 1;
- gfc_conv_expr (&se, vptr_expr);
- gfc_free_expr (vptr_expr);
+ gfc_init_se (&vptr_se, NULL);
+ get_vptr (&vptr_se, expr);
cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
- se.expr,
- build_int_cst (TREE_TYPE (se.expr), 0));
+ vptr_se.expr,
+ build_int_cst (TREE_TYPE (vptr_se.expr), 0));
cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node, cond2, cond);
}
--
2.40.1
[PATCH 08/14] fortran: Push final procedure expr gen close to its one usage.
Final procedure pointer expression is generated in gfc_build_final_call
and only used in get_final_proc_ref. Move the generation there.
gcc/fortran/ChangeLog:
* trans.cc (gfc_add_finalizer_call): Remove local variable
final_expr. Pass down expr to get_final_proc_ref and move
final procedure expression generation down to its one usage
in get_final_proc_ref.
(get_final_proc_ref): Add argument expr. Remove argument
final_wrapper. Recreate final_wrapper from expr.
---
gcc/fortran/trans.cc | 37 -
1 file changed, 20 insertions(+), 17 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index e5ad67199e7..c6a65c87c5c 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1085,12 +1085,25 @@ gfc_call_free (tree var)
}
-/* Generate the data reference to the finalization procedure pointer passed as
- argument in FINAL_WRAPPER. */
+/* Generate the data reference to the finalization procedure pointer associated
+ with the expression passed as argument in EXPR. */
static void
-get_final_proc_ref (gfc_se *se, gfc_expr *final_wrapper)
+get_final_proc_ref (gfc_se *se, gfc_expr *expr)
{
+ gfc_expr *final_wrapper = NULL;
+
+ gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS);
+
+ if (expr->ts.type == BT_DERIVED)
+gfc_is_finalizable (expr->ts.u.derived, &final_wrapper);
+ else
+{
+ final_wrapper = gfc_copy_expr (expr);
+ gfc_add_vptr_component (final_wrapper);
+ gfc_add_final_component (final_wrapper);
+}
+
gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
gfc_conv_expr (se, final_wrapper);
@@ -1308,7 +1321,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
tree tmp;
gfc_ref *ref;
gfc_expr *expr;
- gfc_expr *final_expr = NULL;
bool has_finalizer = false;
if (!expr2 || (expr2->ts.type != BT_DERIVED && expr2->ts.type != BT_CLASS))
@@ -1322,12 +1334,9 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
&& expr2->ts.u.derived->attr.defined_assign_comp)
return false;
- if (expr2->ts.type == BT_DERIVED)
-{
- gfc_is_finalizable (expr2->ts.u.derived, &final_expr);
- if (!final_expr)
-return false;
-}
+ if (expr2->ts.type == BT_DERIVED
+ && !gfc_is_finalizable (expr2->ts.u.derived, NULL))
+return false;
/* If we have a class array, we need go back to the class
container. */
@@ -1358,20 +1367,14 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
if (!expr2->rank && !expr2->ref && CLASS_DATA
(expr2->symtree->n.sym)->as)
expr->rank = CLASS_DATA (expr2->symtree->n.sym)->as->rank;
-
- final_expr = gfc_copy_expr (expr);
- gfc_add_vptr_component (final_expr);
- gfc_add_final_component (final_expr);
}
- gcc_assert (final_expr->expr_type == EXPR_VARIABLE);
-
stmtblock_t tmp_block;
gfc_start_block (&tmp_block);
gfc_se final_se;
gfc_init_se (&final_se, NULL);
- get_final_proc_ref (&final_se, final_expr);
+ get_final_proc_ref (&final_se, expr);
gfc_add_block_to_block (block, &final_se.pre);
gfc_se size_se;
--
2.40.1
[PATCH 13/14] fortran: Use pre-evaluated class container if available [PR110618]
Add the possibility to provide a pre-evaluated class container argument
to gfc_add_finalizer to avoid repeatedly evaluating data reference
expressions in the generated code.
PR fortran/110618
gcc/fortran/ChangeLog:
* trans.h (gfc_add_finalizer_call): Add class container argument.
* trans.cc (gfc_add_finalizer_call): Ditto. Pass down new
argument to get_final_proc_ref, get_elem_size, get_var_desc,
and get_vptr.
(get_elem_size): Add class container argument.
Use provided class container if it's available.
(get_var_descr): Same.
(get_vptr): Same.
(get_final_proc_ref): Same. Add boolean telling the class
container argument is used. Set it. Don't try to use
final_wrapper if class container argument was used.
---
gcc/fortran/trans.cc | 61 +---
gcc/fortran/trans.h | 2 +-
2 files changed, 41 insertions(+), 22 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 69e9329c9cb..18965b9cbd2 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1089,14 +1089,20 @@ gfc_call_free (tree var)
with the expression passed as argument in EXPR. */
static void
-get_final_proc_ref (gfc_se *se, gfc_expr *expr)
+get_final_proc_ref (gfc_se *se, gfc_expr *expr, tree class_container)
{
gfc_expr *final_wrapper = NULL;
gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS);
+ bool using_class_container = false;
if (expr->ts.type == BT_DERIVED)
gfc_is_finalizable (expr->ts.u.derived, &final_wrapper);
+ else if (class_container)
+{
+ using_class_container = true;
+ se->expr = gfc_class_vtab_final_get (class_container);
+}
else
{
final_wrapper = gfc_copy_expr (expr);
@@ -1104,9 +1110,12 @@ get_final_proc_ref (gfc_se *se, gfc_expr *expr)
gfc_add_final_component (final_wrapper);
}
- gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
+ if (!using_class_container)
+{
+ gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
- gfc_conv_expr (se, final_wrapper);
+ gfc_conv_expr (se, final_wrapper);
+}
if (POINTER_TYPE_P (TREE_TYPE (se->expr)))
se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
@@ -1117,7 +1126,7 @@ get_final_proc_ref (gfc_se *se, gfc_expr *expr)
passed as argument in EXPR. */
static void
-get_elem_size (gfc_se *se, gfc_expr *expr)
+get_elem_size (gfc_se *se, gfc_expr *expr, tree class_container)
{
gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS);
@@ -1127,6 +1136,8 @@ get_elem_size (gfc_se *se, gfc_expr *expr)
se->expr = TYPE_SIZE_UNIT (se->expr);
se->expr = fold_convert (gfc_array_index_type, se->expr);
}
+ else if (class_container)
+se->expr = gfc_class_vtab_size_get (class_container);
else
{
gfc_expr *class_size = gfc_copy_expr (expr);
@@ -1143,7 +1154,7 @@ get_elem_size (gfc_se *se, gfc_expr *expr)
expression passed as argument in VAR. */
static void
-get_var_descr (gfc_se *se, gfc_expr *var)
+get_var_descr (gfc_se *se, gfc_expr *var, tree class_container)
{
gfc_se tmp_se;
@@ -1165,6 +1176,8 @@ get_var_descr (gfc_se *se, gfc_expr *var)
// gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
}
}
+ else if (class_container)
+tmp_se.expr = gfc_class_data_get (class_container);
else
{
gfc_expr *array_expr;
@@ -1212,20 +1225,25 @@ get_var_descr (gfc_se *se, gfc_expr *var)
static void
-get_vptr (gfc_se *se, gfc_expr *expr)
+get_vptr (gfc_se *se, gfc_expr *expr, tree class_container)
{
- gfc_expr *vptr_expr = gfc_copy_expr (expr);
- gfc_add_vptr_component (vptr_expr);
+ if (class_container)
+se->expr = gfc_class_vptr_get (class_container);
+ else
+{
+ gfc_expr *vptr_expr = gfc_copy_expr (expr);
+ gfc_add_vptr_component (vptr_expr);
- gfc_se tmp_se;
- gfc_init_se (&tmp_se, NULL);
- tmp_se.want_pointer = 1;
- gfc_conv_expr (&tmp_se, vptr_expr);
- gfc_free_expr (vptr_expr);
+ gfc_se tmp_se;
+ gfc_init_se (&tmp_se, NULL);
+ tmp_se.want_pointer = 1;
+ gfc_conv_expr (&tmp_se, vptr_expr);
+ gfc_free_expr (vptr_expr);
- gfc_add_block_to_block (&se->pre, &tmp_se.pre);
- gfc_add_block_to_block (&se->post, &tmp_se.post);
- se->expr = tmp_se.expr;
+ gfc_add_block_to_block (&se->pre, &tmp_se.pre);
+ gfc_add_block_to_block (&se->post, &tmp_se.post);
+ se->expr = tmp_se.expr;
+}
}
@@ -1329,7 +1347,8 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree
decl, gfc_component *comp,
true when a finalizer call has been inserted. */
bool
-gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2)
+gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2,
+ tree class_container)
{
tree tmp;
gfc_ref *ref;
@@ -1384,17 +1403,17 @@ gfc_add_finalizer_call (stmtbloc
[PATCH 10/14] fortran: Remove redundant argument in get_var_descr
get_var_descr get passed as argument both expr and expr->ts.
Remove the type argument which can be retrieved from the other
argument.
gcc/fortran/ChangeLog:
* trans.cc (get_var_descr): Remove argument ts. Use var->ts
instead.
(gfc_add_finalizer_call): Update caller.
---
gcc/fortran/trans.cc | 9 -
1 file changed, 4 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 99677d37da7..bcf3341fd4b 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1140,11 +1140,10 @@ get_elem_size (gfc_se *se, gfc_expr *expr)
/* Generate the data reference (array) descriptor corresponding to the
- expression passed as argument in VAR. Use type in TS to pilot code
- generation. */
+ expression passed as argument in VAR. */
static void
-get_var_descr (gfc_se *se, gfc_typespec *ts, gfc_expr *var)
+get_var_descr (gfc_se *se, gfc_expr *var)
{
gfc_se tmp_se;
symbol_attribute attr;
@@ -1153,7 +1152,7 @@ get_var_descr (gfc_se *se, gfc_typespec *ts, gfc_expr
*var)
gfc_init_se (&tmp_se, NULL);
- if (ts->type == BT_DERIVED)
+ if (var->ts.type == BT_DERIVED)
{
tmp_se.want_pointer = 1;
if (var->rank)
@@ -1381,7 +1380,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gfc_se desc_se;
gfc_init_se (&desc_se, NULL);
- get_var_descr (&desc_se, &expr->ts, expr);
+ get_var_descr (&desc_se, expr);
gfc_add_block_to_block (&tmp_block, &desc_se.pre);
tmp = build_call_expr_loc (input_location, final_se.expr, 3,
--
2.40.1
[PATCH 14/14] fortran: Pass pre-calculated class container argument [pr110618]
Pass already evaluated class container argument from
gfc_conv_procedure_call down to gfc_add_finalizer_call through
gfc_deallocate_scalar_with_status and gfc_deallocate_with_status,
to avoid repeatedly evaluating the same data reference expressions
in the generated code.
PR fortran/110618
gcc/fortran/ChangeLog:
* trans.h (gfc_deallocate_with_status): Add class container
argument.
(gfc_deallocate_scalar_with_status): Ditto.
* trans.cc (gfc_deallocate_with_status): Add class container
argument and pass it down to gfc_add_finalize_call.
(gfc_deallocate_scalar_with_status): Same.
* trans-array.cc (structure_alloc_comps): Update caller.
* trans-stmt.cc (gfc_trans_deallocate): Ditto.
* trans-expr.cc (gfc_conv_procedure_call): Ditto. Pass
pre-evaluated class container argument if it's available.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_out_22.f90: New test.
---
gcc/fortran/trans-array.cc | 2 +-
gcc/fortran/trans-expr.cc | 7 ++--
gcc/fortran/trans-stmt.cc | 3 +-
gcc/fortran/trans.cc| 11 +++---
gcc/fortran/trans.h | 7 ++--
gcc/testsuite/gfortran.dg/intent_out_22.f90 | 37 +
6 files changed, 55 insertions(+), 12 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_out_22.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1c2af55d436..951cecfa5d5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9472,7 +9472,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
tree dest,
tmp = gfc_deallocate_with_status (comp, NULL_TREE, NULL_TREE,
NULL_TREE, NULL_TREE, true,
- NULL, caf_dereg_mode,
+ NULL, caf_dereg_mode, NULL_TREE,
add_when_allocated, caf_token);
gfc_add_expr_to_block (&tmpblock, tmp);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dbb04f8c434..8258543b456 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6706,9 +6706,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (e->ts.type == BT_CLASS)
ptr = gfc_class_data_get (ptr);
+ tree cls = parmse.class_container;
tmp = gfc_deallocate_scalar_with_status (ptr, NULL_TREE,
NULL_TREE, true,
- e, e->ts);
+ e, e->ts, cls);
gfc_add_expr_to_block (&block, tmp);
tmp = fold_build2_loc (input_location, MODIFY_EXPR,
void_type_node, ptr,
@@ -6900,10 +6901,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
ptr = parmse.expr;
ptr = gfc_class_data_get (ptr);
+ tree cls = parmse.class_container;
tmp = gfc_deallocate_with_status (ptr, NULL_TREE,
NULL_TREE, NULL_TREE,
NULL_TREE, true, e,
- GFC_CAF_COARRAY_NOCOARRAY);
+ GFC_CAF_COARRAY_NOCOARRAY,
+ cls);
gfc_add_expr_to_block (&block, tmp);
tmp = fold_build2_loc (input_location, MODIFY_EXPR,
void_type_node, ptr,
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 7e768343a57..93f36bfb955 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7462,7 +7462,8 @@ gfc_trans_deallocate (gfc_code *code)
{
tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, label_finish,
false, al->expr,
- al->expr->ts, is_coarray);
+ al->expr->ts, NULL_TREE,
+ is_coarray);
gfc_add_expr_to_block (&se.pre, tmp);
/* Set to zero after deallocation. */
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 18965b9cbd2..569fad45031 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1777,8 +1777,8 @@ tree
gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
tree errlen, tree label_finish,
bool can_fail, gfc_expr* expr,
-
[PATCH 12/14] fortran: Factor scalar descriptor generation
The same scalar descriptor generation code is present twice, in the
case of derived type entities, and in the case of polymorphic
non-coarray entities. Factor it in preparation for a future third case
that will also need the same code for scalar descriptor generation.
gcc/fortran/ChangeLog:
* trans.cc (get_var_descr): Factor scalar descriptor generation.
---
gcc/fortran/trans.cc | 33 +++--
1 file changed, 15 insertions(+), 18 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 731dfb626ab..69e9329c9cb 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1146,7 +1146,6 @@ static void
get_var_descr (gfc_se *se, gfc_expr *var)
{
gfc_se tmp_se;
- symbol_attribute attr;
gcc_assert (var);
@@ -1164,13 +1163,6 @@ get_var_descr (gfc_se *se, gfc_expr *var)
{
gfc_conv_expr (&tmp_se, var);
// gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
-
- /* No copy back needed, hence set attr's allocatable/pointer
-to zero. */
- gfc_clear_attr (&attr);
- tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
- attr);
- gcc_assert (tmp_se.post.head == NULL_TREE);
}
}
else
@@ -1191,20 +1183,25 @@ get_var_descr (gfc_se *se, gfc_expr *var)
gfc_add_data_component (array_expr);
gfc_conv_expr (&tmp_se, array_expr);
gcc_assert (tmp_se.post.head == NULL_TREE);
-
- if (!gfc_is_coarray (array_expr))
- {
- /* No copy back needed, hence set attr's allocatable/pointer
-to zero. */
- gfc_clear_attr (&attr);
- tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
- attr);
- }
- gcc_assert (tmp_se.post.head == NULL_TREE);
}
gfc_free_expr (array_expr);
}
+ if (var->rank == 0)
+{
+ if (var->ts.type == BT_DERIVED
+ || !gfc_is_coarray (var))
+ {
+ /* No copy back needed, hence set attr's allocatable/pointer
+to zero. */
+ symbol_attribute attr;
+ gfc_clear_attr (&attr);
+ tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
+ attr);
+ }
+ gcc_assert (tmp_se.post.head == NULL_TREE);
+}
+
if (!POINTER_TYPE_P (TREE_TYPE (tmp_se.expr)))
tmp_se.expr = gfc_build_addr_expr (NULL, tmp_se.expr);
--
2.40.1
[PATCH 03/14] fortran: Outline data reference descriptor evaluation
gcc/fortran/ChangeLog:
* trans.cc (get_var_descr): New function.
(gfc_build_final_call): Outline the data reference descriptor
evaluation code to get_var_descr.
---
gcc/fortran/trans.cc | 149 ---
1 file changed, 83 insertions(+), 66 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 1e4779f94af..9807b7eb9d9 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1124,6 +1124,83 @@ get_elem_size (gfc_se *se, gfc_typespec *ts, gfc_expr
*class_size)
}
+/* Generate the data reference (array) descriptor corresponding to the
+ expression passed as argument in VAR. Use type in TS to pilot code
+ generation. */
+
+static void
+get_var_descr (gfc_se *se, gfc_typespec *ts, gfc_expr *var)
+{
+ gfc_se tmp_se;
+ symbol_attribute attr;
+
+ gcc_assert (var);
+
+ gfc_init_se (&tmp_se, NULL);
+
+ if (ts->type == BT_DERIVED)
+{
+ tmp_se.want_pointer = 1;
+ if (var->rank)
+ {
+ tmp_se.descriptor_only = 1;
+ gfc_conv_expr_descriptor (&tmp_se, var);
+ }
+ else
+ {
+ gfc_conv_expr (&tmp_se, var);
+// gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
+
+ /* No copy back needed, hence set attr's allocatable/pointer
+to zero. */
+ gfc_clear_attr (&attr);
+ tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
+ attr);
+ gcc_assert (tmp_se.post.head == NULL_TREE);
+ }
+}
+ else
+{
+ gfc_expr *array_expr;
+
+ array_expr = gfc_copy_expr (var);
+
+ tmp_se.want_pointer = 1;
+ if (array_expr->rank)
+ {
+ gfc_add_class_array_ref (array_expr);
+ tmp_se.descriptor_only = 1;
+ gfc_conv_expr_descriptor (&tmp_se, array_expr);
+ }
+ else
+ {
+ gfc_add_data_component (array_expr);
+ gfc_conv_expr (&tmp_se, array_expr);
+ gcc_assert (tmp_se.post.head == NULL_TREE);
+
+ if (!gfc_is_coarray (array_expr))
+ {
+ /* No copy back needed, hence set attr's allocatable/pointer
+to zero. */
+ gfc_clear_attr (&attr);
+ tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
+ attr);
+ }
+ gcc_assert (tmp_se.post.head == NULL_TREE);
+ }
+ gfc_free_expr (array_expr);
+}
+
+ if (!POINTER_TYPE_P (TREE_TYPE (tmp_se.expr)))
+tmp_se.expr = gfc_build_addr_expr (NULL, tmp_se.expr);
+
+ gfc_add_block_to_block (&se->pre, &tmp_se.pre);
+ gfc_add_block_to_block (&se->post, &tmp_se.post);
+ se->expr = tmp_se.expr;
+}
+
+
+
/* Build a call to a FINAL procedure, which finalizes "var". */
static tree
@@ -1131,10 +1208,8 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
bool fini_coarray, gfc_expr *class_size)
{
stmtblock_t block;
- gfc_se final_se, size_se;
- gfc_se se;
+ gfc_se final_se, size_se, desc_se;
tree final_fndecl, array, size, tmp;
- symbol_attribute attr;
gcc_assert (var);
@@ -1150,74 +1225,16 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
gfc_add_block_to_block (&block, &size_se.pre);
size = size_se.expr;
- if (ts.type == BT_DERIVED)
-{
- gfc_init_se (&se, NULL);
- se.want_pointer = 1;
- if (var->rank)
- {
- se.descriptor_only = 1;
- gfc_conv_expr_descriptor (&se, var);
- array = se.expr;
- }
- else
- {
- gfc_conv_expr (&se, var);
-// gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
- array = se.expr;
+ gfc_init_se (&desc_se, NULL);
+ get_var_descr (&desc_se, &ts, var);
+ gfc_add_block_to_block (&block, &desc_se.pre);
+ array = desc_se.expr;
- /* No copy back needed, hence set attr's allocatable/pointer
-to zero. */
- gfc_clear_attr (&attr);
- gfc_init_se (&se, NULL);
- array = gfc_conv_scalar_to_descriptor (&se, array, attr);
- gcc_assert (se.post.head == NULL_TREE);
- }
-}
- else
-{
- gfc_expr *array_expr;
-
- array_expr = gfc_copy_expr (var);
- gfc_init_se (&se, NULL);
- se.want_pointer = 1;
- if (array_expr->rank)
- {
- gfc_add_class_array_ref (array_expr);
- se.descriptor_only = 1;
- gfc_conv_expr_descriptor (&se, array_expr);
- array = se.expr;
- }
- else
- {
- gfc_add_data_component (array_expr);
- gfc_conv_expr (&se, array_expr);
- gfc_add_block_to_block (&block, &se.pre);
- gcc_assert (se.post.head == NULL_TREE);
- array = se.expr;
-
- if (!gfc_is_coarray (array_expr))
- {
- /* No copy back needed, hence set attr's a
[PATCH 04/14] fortran: Inline gfc_build_final_call
Function gfc_build_final_call has been simplified, inline it.
gcc/fortran/ChangeLog:
* trans.cc (gfc_build_final_call): Inline...
(gfc_add_finalizer_call): ... to its one caller.
---
gcc/fortran/trans.cc | 66 +---
1 file changed, 25 insertions(+), 41 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 9807b7eb9d9..f8ca388ab9f 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1201,45 +1201,6 @@ get_var_descr (gfc_se *se, gfc_typespec *ts, gfc_expr
*var)
-/* Build a call to a FINAL procedure, which finalizes "var". */
-
-static tree
-gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
- bool fini_coarray, gfc_expr *class_size)
-{
- stmtblock_t block;
- gfc_se final_se, size_se, desc_se;
- tree final_fndecl, array, size, tmp;
-
- gcc_assert (var);
-
- gfc_start_block (&block);
-
- gfc_init_se (&final_se, NULL);
- get_final_proc_ref (&final_se, final_wrapper);
- gfc_add_block_to_block (&block, &final_se.pre);
- final_fndecl = final_se.expr;
-
- gfc_init_se (&size_se, NULL);
- get_elem_size (&size_se, &ts, class_size);
- gfc_add_block_to_block (&block, &size_se.pre);
- size = size_se.expr;
-
- gfc_init_se (&desc_se, NULL);
- get_var_descr (&desc_se, &ts, var);
- gfc_add_block_to_block (&block, &desc_se.pre);
- array = desc_se.expr;
-
- tmp = build_call_expr_loc (input_location,
-final_fndecl, 3, array,
-size, fini_coarray ? boolean_true_node
- : boolean_false_node);
- gfc_add_block_to_block (&block, &desc_se.post);
- gfc_add_expr_to_block (&block, tmp);
- return gfc_finish_block (&block);
-}
-
-
bool
gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component
*comp,
bool fini_coarray)
@@ -1408,8 +1369,31 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gcc_assert (final_expr->expr_type == EXPR_VARIABLE);
- tmp = gfc_build_final_call (expr->ts, final_expr, expr,
- false, elem_size);
+ stmtblock_t tmp_block;
+ gfc_start_block (&tmp_block);
+
+ gfc_se final_se;
+ gfc_init_se (&final_se, NULL);
+ get_final_proc_ref (&final_se, final_expr);
+ gfc_add_block_to_block (&tmp_block, &final_se.pre);
+
+ gfc_se size_se;
+ gfc_init_se (&size_se, NULL);
+ get_elem_size (&size_se, &expr->ts, elem_size);
+ gfc_add_block_to_block (&tmp_block, &size_se.pre);
+
+ gfc_se desc_se;
+ gfc_init_se (&desc_se, NULL);
+ get_var_descr (&desc_se, &expr->ts, expr);
+ gfc_add_block_to_block (&tmp_block, &desc_se.pre);
+
+ tmp = build_call_expr_loc (input_location, final_se.expr, 3,
+desc_se.expr, size_se.expr,
+boolean_false_node);
+
+ gfc_add_block_to_block (&tmp_block, &desc_se.post);
+ gfc_add_expr_to_block (&tmp_block, tmp);
+ tmp = gfc_finish_block (&tmp_block);
if (expr->ts.type == BT_CLASS && !has_finalizer)
{
--
2.40.1
[PATCH 05/14] fortran: Add missing cleanup blocks
Move cleanup code for the data descriptor after the finalization code as it makes more sense to have it after. Other cleanup blocks should be empty (element size and final pointer are just data references), but add them by the way, just in case. gcc/fortran/ChangeLog: * trans.cc (gfc_add_finalizer_call): Add post code for desc_se after the finalizer call. Add post code for final_se and size_se as well. --- gcc/fortran/trans.cc | 6 +- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index f8ca388ab9f..5c953a07533 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1391,8 +1391,12 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) desc_se.expr, size_se.expr, boolean_false_node); - gfc_add_block_to_block (&tmp_block, &desc_se.post); gfc_add_expr_to_block (&tmp_block, tmp); + + gfc_add_block_to_block (&tmp_block, &desc_se.post); + gfc_add_block_to_block (&tmp_block, &size_se.post); + gfc_add_block_to_block (&tmp_block, &final_se.post); + tmp = gfc_finish_block (&tmp_block); if (expr->ts.type == BT_CLASS && !has_finalizer) -- 2.40.1
[PATCH 09/14] fortran: Inline variable definition
The variable has_finalizer is only used in one place, inline its
definition there.
gcc/fortran/ChangeLog:
* trans.cc (gfc_add_finalizer_call): Inline definition of
variable has_finalizer. Merge nested conditions.
---
gcc/fortran/trans.cc | 16 +++-
1 file changed, 7 insertions(+), 9 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index c6a65c87c5c..99677d37da7 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1321,7 +1321,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
tree tmp;
gfc_ref *ref;
gfc_expr *expr;
- bool has_finalizer = false;
if (!expr2 || (expr2->ts.type != BT_DERIVED && expr2->ts.type != BT_CLASS))
return false;
@@ -1361,13 +1360,11 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
ref->next = NULL;
}
- if (expr->ts.type == BT_CLASS)
-{
- has_finalizer = gfc_is_finalizable (expr->ts.u.derived, NULL);
-
- if (!expr2->rank && !expr2->ref && CLASS_DATA
(expr2->symtree->n.sym)->as)
- expr->rank = CLASS_DATA (expr2->symtree->n.sym)->as->rank;
-}
+ if (expr->ts.type == BT_CLASS
+ && !expr2->rank
+ && !expr2->ref
+ && CLASS_DATA (expr2->symtree->n.sym)->as)
+expr->rank = CLASS_DATA (expr2->symtree->n.sym)->as->rank;
stmtblock_t tmp_block;
gfc_start_block (&tmp_block);
@@ -1398,7 +1395,8 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
tmp = gfc_finish_block (&tmp_block);
- if (expr->ts.type == BT_CLASS && !has_finalizer)
+ if (expr->ts.type == BT_CLASS
+ && !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
tree cond;
gfc_se se;
--
2.40.1
Re: spurious out-of-bounds warning message
I would say it is indeed very hard to capture all false positves. Regards, Arjen Op wo 12 jul 2023 om 17:05 schreef Vivek Rao via Fortran < fortran@gcc.gnu.org>: > For the code > > program main > implicit none > integer, parameter :: n = 10 > real :: x(n), dx(n) > integer :: i > call random_number(x) > do i=1,n >if (i > 1) then > dx(i) = x(i) - x(i-1) >else > dx(i) = 0.0 >end if > end do > print*,dx > end program main > > gfortran -Wextra says for GNU Fortran (GCC) 13.0.0 20221218 > > xspur.f90:9:23: > > > 7 | do i=1,n > |2 > 8 |if (i > 1) then > 9 | dx(i) = x(i) - x(i-1) > | 1 > Warning: Array reference at (1) out of bounds (0 < 1) in loop beginning at > (2) [-Wdo-subscript] > > but the code is fine because of the if guard. Ideally such spurious > messages would be suppressed, but I don't know if this is too hard. > > Vivek Rao >
Re: [PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]
Hi Mikael, All 14 patches apply cleanly to trunk, which is rebuilding right now and will regtest this evening. I will review the composite patch tomorrow morning and will come back to you as soon as I can. At first sight all is well; perhaps the commented out line can be dispensed with? Many thanks for this. You are to be commended on your fortitude in putting it all together. The result looks to be considerably neater and more maintainable. If I recall correctly, Tobias was the author of much of this - any comments? Regards Paul On Thu, 13 Jul 2023 at 09:53, Mikael Morin via Fortran wrote: > > Hello, > > the following patches are abot PR110618, a PR similar to PR92178 from which > it is cloned. Both are about a problem of dedendencies between arguments, > when one of them is associated to an allocatable intent(out) dummy, and thus > deallocated in the process of argument association. > > PR110618 exposes a case where the data reference finalization code > for one argument references deallocated data from another argument. > The way I propose to fix this is similar to my recent patches for > PR92178 [1,2] (and is dependent on them). Those patches try to use a data > reference pointer precalculated at the beginning of the process instead of > repeatedly evaluating an expression that becomes invalid at some point > in the generated code. > > Unfortunately, the code for finalization is not prepared for this, as it > only manipulates front-end expressions, whereas the precalculated > pointer is available as middle-end's generic tree. > > These patches refactor the finalization code to ease the introduction > of the forementioned pre-calculated class container pointer. Basically, > four expressions are calculated to build the final procedure call: > the final procedure pointer, the element size, the data reference > (array) descriptor, and (optionally) the virtual table pointer. Each of > the four is outlined stepwise to its own separate function in the > following patches. This abstracts away the generation of these > expressions and makes it easier to add one other way to generate them. > This should also make the impact of the changes more > visible, and regressions easier to spot. > > The main changes are the two last patches introducing an additional > precalculated pointer argument in relevant functions and using them if > set. Details are in the specific patches. > > Each patch has been bubble-bootstrapped and partially tested > with RUNTESTFLAGS="dg.exp=*final*". > The complete set has been fully tested on x86_64-pc-linux-gnu. > OK for master? > > [1] https://gcc.gnu.org/pipermail/fortran/2023-July/059582.html > [2] https://gcc.gnu.org/pipermail/fortran/2023-July/059583.html > > Mikael Morin (14): > fortran: Outline final procedure pointer evaluation > fortran: Outline element size evaluation > fortran: Outline data reference descriptor evaluation > fortran: Inline gfc_build_final_call > fortran: Add missing cleanup blocks > fortran: Reuse final procedure pointer expression > fortran: Push element size expression generation close to its usage > fortran: Push final procedure expr gen close to its one usage. > fortran: Inline variable definition > fortran: Remove redundant argument in get_var_descr > fortran: Outline virtual table pointer evaluation > fortran: Factor scalar descriptor generation > fortran: Use pre-evaluated class container if available [PR110618] > fortran: Pass pre-calculated class container argument [pr110618] > > gcc/fortran/trans-array.cc | 2 +- > gcc/fortran/trans-expr.cc | 7 +- > gcc/fortran/trans-stmt.cc | 3 +- > gcc/fortran/trans.cc| 314 > gcc/fortran/trans.h | 9 +- > gcc/testsuite/gfortran.dg/intent_out_22.f90 | 37 +++ > 6 files changed, 237 insertions(+), 135 deletions(-) > create mode 100644 gcc/testsuite/gfortran.dg/intent_out_22.f90 > > -- > 2.40.1 > -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein
Re: [PATCH 0/3] Fix argument evaluation order [PR92178]
Hi Mikael, Am 11.07.23 um 12:32 schrieb Mikael Morin via Gcc-patches: Hello, this is a followup to Harald's recent work [1] on the evaluation order of arguments, when one of them is passed to an intent(out) allocatable dummy and is deallocated before the call. This extends Harald's fix to support: - scalars passed to assumed rank dummies (patch 1), - scalars passed to assumed rank dummies with the data reference depending on its own content (patch 2), - arrays with the data reference depending on its own content (patch 3). There is one (last?) case which is not supported, for which I have opened a separate PR [2]. Regression tested on x86_64-pc-linux-gnu. OK for master? this is an impressive improvement for the CLASS case. Maybe Paul wants to have another look at it, but it is OK from my side. Thanks for the patch! Harald [1] https://gcc.gnu.org/pipermail/fortran/2023-July/059562.html [2] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=110618 Mikael Morin (3): fortran: defer class wrapper initialization after deallocation [PR92178] fortran: Factor data references for scalar class argument wrapping [PR92178] fortran: Reorder array argument evaluation parts [PR92178] gcc/fortran/trans-array.cc | 3 + gcc/fortran/trans-expr.cc | 130 +--- gcc/fortran/trans.cc| 28 + gcc/fortran/trans.h | 8 +- gcc/testsuite/gfortran.dg/intent_out_19.f90 | 22 gcc/testsuite/gfortran.dg/intent_out_20.f90 | 33 + gcc/testsuite/gfortran.dg/intent_out_21.f90 | 33 + 7 files changed, 236 insertions(+), 21 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intent_out_19.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_out_20.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_out_21.f90
Re: [PATCH 14/14] fortran: Pass pre-calculated class container argument [pr110618]
Hi Mikhail,
This patch uses a field for gfc_se called class container, which is
neither declared nor set as far as I can tell.
Regards
Paul
On Thu, 13 Jul 2023 at 10:05, Mikael Morin via Fortran
wrote:
>
> Pass already evaluated class container argument from
> gfc_conv_procedure_call down to gfc_add_finalizer_call through
> gfc_deallocate_scalar_with_status and gfc_deallocate_with_status,
> to avoid repeatedly evaluating the same data reference expressions
> in the generated code.
>
> PR fortran/110618
>
> gcc/fortran/ChangeLog:
>
> * trans.h (gfc_deallocate_with_status): Add class container
> argument.
> (gfc_deallocate_scalar_with_status): Ditto.
> * trans.cc (gfc_deallocate_with_status): Add class container
> argument and pass it down to gfc_add_finalize_call.
> (gfc_deallocate_scalar_with_status): Same.
> * trans-array.cc (structure_alloc_comps): Update caller.
> * trans-stmt.cc (gfc_trans_deallocate): Ditto.
> * trans-expr.cc (gfc_conv_procedure_call): Ditto. Pass
> pre-evaluated class container argument if it's available.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/intent_out_22.f90: New test.
> ---
> gcc/fortran/trans-array.cc | 2 +-
> gcc/fortran/trans-expr.cc | 7 ++--
> gcc/fortran/trans-stmt.cc | 3 +-
> gcc/fortran/trans.cc| 11 +++---
> gcc/fortran/trans.h | 7 ++--
> gcc/testsuite/gfortran.dg/intent_out_22.f90 | 37 +
> 6 files changed, 55 insertions(+), 12 deletions(-)
> create mode 100644 gcc/testsuite/gfortran.dg/intent_out_22.f90
>
> diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
> index 1c2af55d436..951cecfa5d5 100644
> --- a/gcc/fortran/trans-array.cc
> +++ b/gcc/fortran/trans-array.cc
> @@ -9472,7 +9472,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
> decl, tree dest,
>
> tmp = gfc_deallocate_with_status (comp, NULL_TREE, NULL_TREE,
> NULL_TREE, NULL_TREE, true,
> - NULL, caf_dereg_mode,
> + NULL, caf_dereg_mode,
> NULL_TREE,
> add_when_allocated,
> caf_token);
>
> gfc_add_expr_to_block (&tmpblock, tmp);
> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
> index dbb04f8c434..8258543b456 100644
> --- a/gcc/fortran/trans-expr.cc
> +++ b/gcc/fortran/trans-expr.cc
> @@ -6706,9 +6706,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
> if (e->ts.type == BT_CLASS)
> ptr = gfc_class_data_get (ptr);
>
> + tree cls = parmse.class_container;
> tmp = gfc_deallocate_scalar_with_status (ptr, NULL_TREE,
>NULL_TREE,
> true,
> - e, e->ts);
> + e, e->ts, cls);
> gfc_add_expr_to_block (&block, tmp);
> tmp = fold_build2_loc (input_location, MODIFY_EXPR,
> void_type_node, ptr,
> @@ -6900,10 +6901,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
> sym,
> ptr = parmse.expr;
> ptr = gfc_class_data_get (ptr);
>
> + tree cls = parmse.class_container;
> tmp = gfc_deallocate_with_status (ptr, NULL_TREE,
> NULL_TREE, NULL_TREE,
> NULL_TREE, true, e,
> -
> GFC_CAF_COARRAY_NOCOARRAY);
> + GFC_CAF_COARRAY_NOCOARRAY,
> + cls);
> gfc_add_expr_to_block (&block, tmp);
> tmp = fold_build2_loc (input_location, MODIFY_EXPR,
> void_type_node, ptr,
> diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
> index 7e768343a57..93f36bfb955 100644
> --- a/gcc/fortran/trans-stmt.cc
> +++ b/gcc/fortran/trans-stmt.cc
> @@ -7462,7 +7462,8 @@ gfc_trans_deallocate (gfc_code *code)
> {
> tmp = gfc_deallocate_scalar_with_status (se.expr, pstat,
> label_finish,
>false, al->expr,
> - al->expr->ts, is_coarray);
> + al->expr->ts, NULL_TREE,
> + is_coarray);
> gfc_add_expr_to_block (&se.pre, tmp);
>
> /* Set to zero after deallocation
