This is probably the most risky patch in the series.

A previous version of this patch allowing all exactly matching derived
types showed two regressions.  One of them uncovered PR106817 for which
I added a fix in this series, and for the other I have excluded
types with allocatable components from clobbering.

I have additionnally excluded finalizable types for similar reasons, and
parameterized derived type because they may not be constant-sized.

I hope we are safe for all the rest.

-- >8 --

This adds support for clobbering of non-polymorphic derived type
variables, when they are passed as actual argument whose associated
dummy has the INTENT(OUT) attribute.

We avoid to play with non-constant type sizes or class descriptors by
requiring that the types are derived (not class) and strictly matching,
and by excluding parameterized derived types.

Types that are used in the callee are also excluded: they are types with
allocatable components (the components will be deallocated), and
finalizable types or types with finalizable components (they will be
passed to finalization routines).

        PR fortran/41453

gcc/fortran/ChangeLog:

        * trans-expr.cc (gfc_conv_procedure_call): Allow strictly
        matching derived types.

gcc/testsuite/ChangeLog:

        * gfortran.dg/intent_optimize_8.f90: New test.
---
 gcc/fortran/trans-expr.cc                     | 18 ++++-
 .../gfortran.dg/intent_optimize_8.f90         | 67 +++++++++++++++++++
 2 files changed, 84 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_8.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f1026d7f309..f8fcd2d97d9 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6523,8 +6523,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                          && e->expr_type == EXPR_VARIABLE
                          && e->rank == 0
                          && e->ts.type != BT_CHARACTER
-                         && e->ts.type != BT_DERIVED
                          && e->ts.type != BT_CLASS
+                         && (e->ts.type != BT_DERIVED
+                             || (dsym->ts.type == BT_DERIVED
+                                 && e->ts.u.derived == dsym->ts.u.derived
+                                 /* Types with allocatable components are
+                                    excluded from clobbering because we need
+                                    the unclobbered pointers to free the
+                                    allocatable components in the callee.
+                                    Same goes for finalizable types or types
+                                    with finalizable components, we need to
+                                    pass the unclobbered values to the
+                                    finalization routines.
+                                    For parameterized types, it's less clear
+                                    but they may not have a constant size
+                                    so better exclude them in any case.  */
+                                 && !e->ts.u.derived->attr.alloc_comp
+                                 && !e->ts.u.derived->attr.pdt_type
+                                 && !gfc_is_finalizable (e->ts.u.derived, 
NULL)))
                          && !sym->attr.elemental)
                        {
                          tree var;
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_8.f90 
b/gcc/testsuite/gfortran.dg/intent_optimize_8.f90
new file mode 100644
index 00000000000..584592842e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_8.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized 
-fdump-tree-original" }
+!
+! PR fortran/41453
+! Check that the INTENT(OUT) attribute causes in the case of non-polymorphic 
derived type arguments:
+!  - one clobber to be emitted in the caller before calls to FOO in the 
*.original dump,
+!  - no clobber to be emitted in the caller before calls to BAR in the 
*.original dump,
+!  - the initialization constants to be optimized away in the *.optimized dump.
+
+module x
+  implicit none
+  type :: t
+    integer :: c
+  end type t
+  type, extends(t) :: u
+    integer :: d
+  end type u
+contains
+  subroutine foo(a)
+    type(t), intent(out) :: a
+    a = t(42)
+  end subroutine foo
+  subroutine bar(b)
+    class(t), intent(out) :: b
+    b%c = 24
+  end subroutine bar
+end module x
+
+program main
+  use x
+  implicit none
+  type(t) :: tc
+  type(u) :: uc, ud
+  class(t), allocatable :: te, tf
+
+  tc = t(123456789)
+  call foo(tc)
+  if (tc%c /= 42) stop 1
+
+  uc = u(987654321, 0)
+  call foo(uc%t)
+  if (uc%c /= 42) stop 2
+  if (uc%d /= 0) stop 3
+
+  ud = u(11223344, 0)
+  call bar(ud)
+  if (ud%c /= 24) stop 4
+
+  te = t(55667788)
+  call foo(te)
+  if (te%c /= 42) stop 5
+
+  tf = t(99887766)
+  call bar(tf)
+  if (tf%c /= 24) stop 6
+
+end program main
+
+! We don't support class descriptors, so there are clobbers for tc and uc 
only; no clobber for ud, te, tf.
+! { dg-final { scan-tree-dump-times "CLOBBER" 2 "original" } }
+! { dg-final { scan-tree-dump "tc = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "uc\\.t = {CLOBBER};" "original" } }
+
+! There are clobbers for tc and uc, so we should manage to optimize away the 
associated initialization constants (but not other
+! initialization constants).
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target 
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump-not "987654321" "optimized" { target 
__OPTIMIZE__ } } }
-- 
2.35.1

Reply via email to