https://gcc.gnu.org/g:105d80746bfb38307e3ade6fbf453644d73ba711
commit 105d80746bfb38307e3ade6fbf453644d73ba711
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Thu Jul 24 22:01:52 2025 +0200
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:
---
gcc/fortran/trans-array.cc | 54 ++++++++++++++++++++++-----------
gcc/testsuite/gfortran.dg/assign_14.f90 | 24 +++++++++++++++
2 files changed, 60 insertions(+), 18 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index fffa6db639b6..6b759d13f1a3 100644
--- 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
index 000000000000..33b46b9424a9
--- /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
