[PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]

[PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]

[Mikael Morin]

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 01/14] fortran: Outline final procedure pointer evaluation

[Mikael Morin]

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 02/14] fortran: Outline element size evaluation

[Mikael Morin]

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 03/14] fortran: Outline data reference descriptor evaluation

[Mikael Morin]

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 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);
-	}
-      gfc_free_expr (array_expr);
-    }
-
-  if (!POINTER_TYPE_P (TREE_TYPE (array)))
-    array = gfc_build_addr_expr (NULL, array);
-
-  gfc_add_block_to_block (&block, &se.pre);
   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, &se.post);
+  gfc_add_block_to_block (&block, &desc_se.post);
   gfc_add_expr_to_block (&block, tmp);
   return gfc_finish_block (&block);
 }
-- 
2.40.1

[PATCH 04/14] fortran: Inline gfc_build_final_call

[Mikael Morin]

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

[Mikael Morin]

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 06/14] fortran: Reuse final procedure pointer expression

[Mikael Morin]

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

[Mikael Morin]

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 08/14] fortran: Push final procedure expr gen close to its one usage.

[Mikael Morin]

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 09/14] fortran: Inline variable definition

[Mikael Morin]

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

[PATCH 10/14] fortran: Remove redundant argument in get_var_descr

[Mikael Morin]

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 11/14] fortran: Outline virtual table pointer evaluation

[Mikael Morin]

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 12/14] fortran: Factor scalar descriptor generation

[Mikael Morin]

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 13/14] fortran: Use pre-evaluated class container if available [PR110618]

[Mikael Morin]

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 (stmtblock_t *block, gfc_expr *expr2)
 
   gfc_se final_se;
   gfc_init_se (&final_se, NULL);
-  get_final_proc_ref (&final_se, expr);
+  get_final_proc_ref (&final_se, expr, class_container);
   gfc_add_block_to_block (block, &final_se.pre);
 
   gfc_se size_se;
   gfc_init_se (&size_se, NULL);
-  get_elem_size (&size_se, expr);
+  get_elem_size (&size_se, expr, class_container);
   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);
+  get_var_descr (&desc_se, expr, class_container);
   gfc_add_block_to_block (&tmp_block, &desc_se.pre);
 
   tmp = build_call_expr_loc (input_location, final_se.expr, 3,
@@ -1426,7 +1445,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2)
 	  gfc_se vptr_se;
 
 	  gfc_init_se (&vptr_se, NULL);
-	  get_vptr (&vptr_se, expr);
+	  get_vptr (&vptr_se, expr, class_container);
 
 	  cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
 				   vptr_se.expr,
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 7b41e8912b4..be9ccbc3d29 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -457,7 +457,7 @@ tree gfc_get_class_from_gfc_expr (gfc_expr *);
 tree gfc_get_class_from_expr (tree);
 tree gfc_get_vptr_from_expr (tree);
 tree gfc_copy_class_to_class (tree, tree, tree, bool);
-bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *);
+bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *, tree = NULL_TREE);
 bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool);
 void gfc_finalize_tree_expr (gfc_se *, gfc_symbol *, symbol_attribute, int);
 bool gfc_assignment_finalizer_call (gfc_se *, gfc_expr *, bool);
-- 
2.40.1

[PATCH 14/14] fortran: Pass pre-calculated class container argument [pr110618]

[Mikael Morin]

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,
-			    int coarray_dealloc_mode, tree add_when_allocated,
-			    tree caf_token)
+			    int coarray_dealloc_mode, tree class_container,
+			    tree add_when_allocated, tree caf_token)
 {
   stmtblock_t null, non_null;
   tree cond, tmp, error;
@@ -1872,7 +1872,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
   gfc_start_block (&non_null);
   if (add_when_allocated)
     gfc_add_expr_to_block (&non_null, add_when_allocated);
-  gfc_add_finalizer_call (&non_null, expr);
+  gfc_add_finalizer_call (&non_null, expr, class_container);
   if (coarray_dealloc_mode == GFC_CAF_COARRAY_NOCOARRAY
       || flag_coarray != GFC_FCOARRAY_LIB)
     {
@@ -1977,7 +1977,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
 tree
 gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
 				   bool can_fail, gfc_expr* expr,
-				   gfc_typespec ts, bool coarray)
+				   gfc_typespec ts, tree class_container,
+				   bool coarray)
 {
   stmtblock_t null, non_null;
   tree cond, tmp, error;
@@ -2030,7 +2031,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
   gfc_start_block (&non_null);
 
   /* Free allocatable components.  */
-  finalizable = gfc_add_finalizer_call (&non_null, expr);
+  finalizable = gfc_add_finalizer_call (&non_null, expr, class_container);
   if (!finalizable && ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
     {
       int caf_mode = coarray
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index be9ccbc3d29..109d7647235 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -771,10 +771,11 @@ void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree);
 
 /* Generate code to deallocate an array.  */
 tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool,
-				 gfc_expr *, int, tree a = NULL_TREE,
-				 tree c = NULL_TREE);
+				 gfc_expr *, int, tree = NULL_TREE,
+				 tree a = NULL_TREE, tree c = NULL_TREE);
 tree gfc_deallocate_scalar_with_status (tree, tree, tree, bool, gfc_expr*,
-					gfc_typespec, bool c = false);
+					gfc_typespec, tree = NULL_TREE,
+					bool c = false);
 
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
diff --git a/gcc/testsuite/gfortran.dg/intent_out_22.f90 b/gcc/testsuite/gfortran.dg/intent_out_22.f90
new file mode 100644
index 00000000000..a38afccf0e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_22.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! PR fortran/110618
+! Check that if a data reference is passed as actual argument whose dummy
+! has INTENT(OUT) attribute, any other argument depending on the
+! same data reference is evaluated before the data reference deallocation.
+
+program p
+  implicit none
+  type t
+    integer :: i
+  end type t
+  type u
+    class(t), allocatable :: ta(:)
+  end type u
+  type(u), allocatable :: c(:)
+  class(t), allocatable :: d(:)
+  allocate(c, source = [u([t(1), t(3)]), u([t(4), t(9)])])
+  allocate(d, source = [t(1), t(5)])
+  call bar (                   &
+      allocated(c(d(1)%i)%ta), &
+      d,                       &
+      c(d(1)%i)%ta,            &
+      allocated (c(d(1)%i)%ta) &
+  )
+  if (allocated (c(1)%ta)) stop 11
+  if (.not. allocated (c(2)%ta)) stop 11
+contains
+  subroutine bar (alloc, x, y, alloc2)
+    logical :: alloc, alloc2
+    class(t), allocatable, intent(out) :: x(:)
+    class(t), allocatable, intent(out) :: y(:)
+    if (allocated (x)) stop 1
+    if (.not. alloc)   stop 2
+    if (.not. alloc2)  stop 3
+  end subroutine bar
+end
-- 
2.40.1

Re: [PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]

[Paul Richard Thomas]

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
<fortran@gcc.gnu.org> 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 14/14] fortran: Pass pre-calculated class container argument [pr110618]

[Paul Richard Thomas]

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
<fortran@gcc.gnu.org> 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.  */
> 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,
> -                           int coarray_dealloc_mode, tree add_when_allocated,
> -                           tree caf_token)
> +                           int coarray_dealloc_mode, tree class_container,
> +                           tree add_when_allocated, tree caf_token)
>  {
>    stmtblock_t null, non_null;
>    tree cond, tmp, error;
> @@ -1872,7 +1872,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
>    gfc_start_block (&non_null);
>    if (add_when_allocated)
>      gfc_add_expr_to_block (&non_null, add_when_allocated);
> -  gfc_add_finalizer_call (&non_null, expr);
> +  gfc_add_finalizer_call (&non_null, expr, class_container);
>    if (coarray_dealloc_mode == GFC_CAF_COARRAY_NOCOARRAY
>        || flag_coarray != GFC_FCOARRAY_LIB)
>      {
> @@ -1977,7 +1977,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
>  tree
>  gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
>                                    bool can_fail, gfc_expr* expr,
> -                                  gfc_typespec ts, bool coarray)
> +                                  gfc_typespec ts, tree class_container,
> +                                  bool coarray)
>  {
>    stmtblock_t null, non_null;
>    tree cond, tmp, error;
> @@ -2030,7 +2031,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
>    gfc_start_block (&non_null);
>
>    /* Free allocatable components.  */
> -  finalizable = gfc_add_finalizer_call (&non_null, expr);
> +  finalizable = gfc_add_finalizer_call (&non_null, expr, class_container);
>    if (!finalizable && ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
>      {
>        int caf_mode = coarray
> diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
> index be9ccbc3d29..109d7647235 100644
> --- a/gcc/fortran/trans.h
> +++ b/gcc/fortran/trans.h
> @@ -771,10 +771,11 @@ void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree);
>
>  /* Generate code to deallocate an array.  */
>  tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool,
> -                                gfc_expr *, int, tree a = NULL_TREE,
> -                                tree c = NULL_TREE);
> +                                gfc_expr *, int, tree = NULL_TREE,
> +                                tree a = NULL_TREE, tree c = NULL_TREE);
>  tree gfc_deallocate_scalar_with_status (tree, tree, tree, bool, gfc_expr*,
> -                                       gfc_typespec, bool c = false);
> +                                       gfc_typespec, tree = NULL_TREE,
> +                                       bool c = false);
>
>  /* Generate code to call realloc().  */
>  tree gfc_call_realloc (stmtblock_t *, tree, tree);
> diff --git a/gcc/testsuite/gfortran.dg/intent_out_22.f90 b/gcc/testsuite/gfortran.dg/intent_out_22.f90
> new file mode 100644
> index 00000000000..a38afccf0e5
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/intent_out_22.f90
> @@ -0,0 +1,37 @@
> +! { dg-do run }
> +!
> +! PR fortran/110618
> +! Check that if a data reference is passed as actual argument whose dummy
> +! has INTENT(OUT) attribute, any other argument depending on the
> +! same data reference is evaluated before the data reference deallocation.
> +
> +program p
> +  implicit none
> +  type t
> +    integer :: i
> +  end type t
> +  type u
> +    class(t), allocatable :: ta(:)
> +  end type u
> +  type(u), allocatable :: c(:)
> +  class(t), allocatable :: d(:)
> +  allocate(c, source = [u([t(1), t(3)]), u([t(4), t(9)])])
> +  allocate(d, source = [t(1), t(5)])
> +  call bar (                   &
> +      allocated(c(d(1)%i)%ta), &
> +      d,                       &
> +      c(d(1)%i)%ta,            &
> +      allocated (c(d(1)%i)%ta) &
> +  )
> +  if (allocated (c(1)%ta)) stop 11
> +  if (.not. allocated (c(2)%ta)) stop 11
> +contains
> +  subroutine bar (alloc, x, y, alloc2)
> +    logical :: alloc, alloc2
> +    class(t), allocatable, intent(out) :: x(:)
> +    class(t), allocatable, intent(out) :: y(:)
> +    if (allocated (x)) stop 1
> +    if (.not. alloc)   stop 2
> +    if (.not. alloc2)  stop 3
> +  end subroutine bar
> +end
> --
> 2.40.1
>


-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: [PATCH 14/14] fortran: Pass pre-calculated class container argument [pr110618]

[Mikael Morin]

Hello,

Le 14/07/2023 à 07:55, Paul Richard Thomas via Fortran a écrit :
> 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.
> 
These patches are dependent on my previous patchset for pr92178.
Sorry, I didn't highlight that enough obviously.

The field is declared and set here:
https://gcc.gnu.org/pipermail/fortran/2023-July/059582.html
https://gcc.gnu.org/pipermail/gcc-patches/2023-July/624083.html

It is additionally set in one more place in the next patch here:
https://gcc.gnu.org/pipermail/fortran/2023-July/059583.html
https://gcc.gnu.org/pipermail/gcc-patches/2023-July/624084.html

Re: [PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]

[Paul Richard Thomas]

Hi Mikael,

I apologise for not being a bit faster with the review. I appreciate
that you put a lot of effort into presenting the work in digestible
chunks. Perhaps this is a personal perspective but I found it more
difficult to absorb than reviewing a single patch. What do others
think?

That said, this is a big improvement to the finalization of variable
expressions. I can also confirm that the composite patch applies
cleanly and regtests without problems. Please either remove or
uncomment the line:
//   gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);

I presume that it reflects some case where the assertion failed? If
so, it might be prudent to retain the assertion especially in light
of:
  gcc_assert (tmp_se.post.head == NULL_TREE); a bit further down.

OK for trunk

Thanks for all the work and the patches.

Paul

On Thu, 13 Jul 2023 at 19:40, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
>
> 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
> <fortran@gcc.gnu.org> 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



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: [PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]

[Mikael Morin]

Le 15/07/2023 à 08:11, Paul Richard Thomas via Fortran a écrit :
> Hi Mikael,
> 
> I apologise for not being a bit faster with the review. I appreciate
> that you put a lot of effort into presenting the work in digestible
> chunks. Perhaps this is a personal perspective but I found it more
> difficult to absorb than reviewing a single patch. What do others
> think?
> 
I understand it makes it more difficult to get the bigger, high level, 
picture.  On the other hand, it separates pure reorganization changes 
from real changes, and should help to isolate regressions, if any.  A 
single patch looks to me like it rewrites big chunks with new code, 
which is not really the case here.

> That said, this is a big improvement to the finalization of variable
> expressions. I can also confirm that the composite patch applies
> cleanly and regtests without problems. Please either remove or
> uncomment the line:
> //   gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
> 
> I presume that it reflects some case where the assertion failed? If
> so, it might be prudent to retain the assertion especially in light
> of:
>    gcc_assert (tmp_se.post.head == NULL_TREE); a bit further down.
> 
Honestly, I can't really say.  I just carried it around unchanged, as it 
was originally, in patch 3/14.  By the way, this makes me notice that 
the variable name should have been changed from se to tmp_se.
As both pre and post blocks are copied to the final code block, I think 
the assertions are not useful and can just be removed.

> OK for trunk
> 
> Thanks for all the work and the patches.
> 
Thanks for your review, and sorry for the wasted energy in getting a 
usable work tree.

Re: [PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]

[Mikael Morin]

Le 15/07/2023 à 12:08, Mikael Morin a écrit :
> Le 15/07/2023 à 08:11, Paul Richard Thomas via Fortran a écrit :
>> That said, this is a big improvement to the finalization of variable
>> expressions. I can also confirm that the composite patch applies
>> cleanly and regtests without problems. Please either remove or
>> uncomment the line:
>> //   gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
>>
>> I presume that it reflects some case where the assertion failed? If
>> so, it might be prudent to retain the assertion especially in light
>> of:
>>    gcc_assert (tmp_se.post.head == NULL_TREE); a bit further down.
>>
> Honestly, I can't really say.  I just carried it around unchanged, as it 
> was originally, in patch 3/14.  By the way, this makes me notice that 
> the variable name should have been changed from se to tmp_se.
> As both pre and post blocks are copied to the final code block, I think 
> the assertions are not useful and can just be removed.
> 
I have had a more in detail look at this commented assert, and it 
appears that you are actually the person who commented it out, in 
revision r13-6747-gd7caf313525a46f200d7f5db1ba893f853774aee from last march.
Don't you remember any detail about it?

Before that, the assert was present from the start, when the function 
was introduced.
Uncommenting it doesn't seem to bring any new testsuite failure, but 
again I don't really see what it would protect against.

Re: [PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]

[Paul Richard Thomas]

Hi Mikhail,

That's ever so slightly embarrassing :-) My notes for that commit
don't provide any enlightenment.

Thanks

Paul

Re: [PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]

[Mikael Morin]

Le 15/07/2023 à 08:11, Paul Richard Thomas a écrit :
> Please either remove or
> uncomment the line:
> //   gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
> 
> I presume that it reflects some case where the assertion failed? If
> so, it might be prudent to retain the assertion especially in light
> of:
>    gcc_assert (tmp_se.post.head == NULL_TREE); a bit further down.
> 
I have finally found an example making the assert fail and pushed the 
patches with the assert removed and the test added to the testsuite.