fortran: Trigger reference saving on pointer dereference [PR121185]

This is a follow-up to revision:
r16-2371-g8f41c87654fd819e48c9f6f1ac3d87e35794d310
fortran: Factor array descriptor references

That revision introduced new variables to limit repeated subexpressions
in array descriptor references.  The change added a walk along the
reference from child to parent, that selected subreferences worth
saving and applied the saving if the reference proved non-trivial
enough.  Trivialness was defined in a comment as: only made of a DECL
and NOPs and COMPONENTs.  But the case of a pointer derefence didn't
trigger the saving, so the code was also considering a dereference as if
it was trivial.

This change triggers the reference saving on pointer dereferences,
making the trivialness as defined by the code aligned with the comment.

This change is not strictly speaking a bug fix, but PR #121185 exhibited
wrong code examples where the lack of a variable hiding the polymorphic
leading part of a non-polymorphic array reference was causing the latter
to be evaluated in a polymorphic way.

	PR fortran/121185

gcc/fortran/ChangeLog:

	* trans-array.cc (set_factored_descriptor_value): Also trigger
	the saving of the previously selected reference on encountering
	an INDIRECT_REF.  Extract the saving code...
	(save_ref): ... here as a new function.

gcc/testsuite/ChangeLog:

	* gfortran.dg/assign_14.f90: New test.

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index fffa6db639b6fa0660f1e311b6db0c76100a86d2..6b759d13f1a3ba934bc5efce54af3ee5be63ecad 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3478,6 +3478,29 @@ substitute_subexpr_in_expr (tree target, tree replacement, tree expr)
 }
 
 
+/* Save REF to a fresh variable in all of REPLACEMENT_ROOTS, appending extra
+   code to CODE.  Before returning, add REF to REPLACEMENT_ROOTS and clear
+   REF.  */
+
+static void
+save_ref (tree &code, tree &ref, vec<tree> &replacement_roots)
+{
+  stmtblock_t tmp_block;
+  gfc_init_block (&tmp_block);
+  tree var = gfc_evaluate_now (ref, &tmp_block);
+  gfc_add_expr_to_block (&tmp_block, code);
+  code = gfc_finish_block (&tmp_block);
+
+  unsigned i;
+  tree repl_root;
+  FOR_EACH_VEC_ELT (replacement_roots, i, repl_root)
+    substitute_subexpr_in_expr (ref, var, repl_root);
+
+  replacement_roots.safe_push (ref);
+  ref = NULL_TREE;
+}
+
+
 /* Save the descriptor reference VALUE to storage pointed by DESC_PTR.  Before
    that, try to factor subexpressions of VALUE to variables, adding extra code
    to BLOCK.
@@ -3492,11 +3515,8 @@ set_factored_descriptor_value (tree *desc_ptr, tree value, stmtblock_t *block)
   /* As the reference is processed from outer to inner, variable definitions
      will be generated in reversed order, so can't be put directly in BLOCK.
      We use TMP_BLOCK instead.  */
-  stmtblock_t tmp_block;
   tree accumulated_code = NULL_TREE;
 
-  gfc_init_block (&tmp_block);
-
   /* The current candidate to factoring.  */
   tree saveable_ref = NULL_TREE;
 
@@ -3526,8 +3546,18 @@ set_factored_descriptor_value (tree *desc_ptr, tree value, stmtblock_t *block)
 
          if (!maybe_reallocatable)
            {
+             if (saveable_ref != NULL_TREE && saveable_ref != data_ref)
+               {
+                 /* A reference worth saving has been seen, and now the pointer
+                    to the current reference is also worth saving.  If the
+                    previous reference to save wasn't the current one, do save
+                    it now.  Otherwise drop it as we prefer saving the
+                    pointer.  */
+                 save_ref (accumulated_code, saveable_ref, replacement_roots);
+               }
+
              /* Don't evaluate the pointer to a variable yet; do it only if the
-                variable would be significantly more simple than the reference
+                variable would be significantly more simple than the reference
                 it replaces.  That is if the reference contains anything
                 different from NOPs, COMPONENTs and DECLs.  */
              saveable_ref = next_ref;
@@ -3552,20 +3582,8 @@ set_factored_descriptor_value (tree *desc_ptr, tree value, stmtblock_t *block)
            }
 
          if (saveable_ref != NULL_TREE)
-           {
-             /* We have seen a reference worth saving.  Do it now.  */
-             tree var = gfc_evaluate_now (saveable_ref, &tmp_block);
-             gfc_add_expr_to_block (&tmp_block, accumulated_code);
-             accumulated_code = gfc_finish_block (&tmp_block);
-
-             unsigned i;
-             tree repl_root;
-             FOR_EACH_VEC_ELT (replacement_roots, i, repl_root)
-               substitute_subexpr_in_expr (saveable_ref, var, repl_root);
-
-             replacement_roots.safe_push (saveable_ref);
-             saveable_ref = NULL_TREE;
-           }
+           /* We have seen a reference worth saving.  Do it now.  */
+           save_ref (accumulated_code, saveable_ref, replacement_roots);
 
          if (TREE_CODE (data_ref) != ARRAY_REF)
            break;

diff --git a/gcc/testsuite/gfortran.dg/assign_14.f90 b/gcc/testsuite/gfortran.dg/assign_14.f90
new file mode 100644 (file)
index 0000000..33b46b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_14.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-additional-options {-fdump-tree-original} }
+!
+! PR fortran/121185
+! Check that an intermediary variable is used to reference component a.
+! { dg-final { scan-tree-dump-not {->b->a} original } }
+
+program p
+  implicit none
+  type t
+     integer, allocatable :: a(:)
+  end type t
+  type u
+     type(t), allocatable :: b
+  end type u
+  type v
+     type(u), allocatable :: c
+  end type v
+  type(v) :: z
+  z%c = u()
+  z%c%b = t()
+  z%c%b%a = [1,2]
+  z%c%b%a = z%c%b%a * 2
+end