[gcc r13-2841] fortran: Support clobbering of derived types [PR41453]

[gcc r13-2841] fortran: Support clobbering of derived types [PR41453]

[Mikael Morin]

https://gcc.gnu.org/g:77bbf69d2981dafc2ef3e59bfbefb645d88bab9d

commit r13-2841-g77bbf69d2981dafc2ef3e59bfbefb645d88bab9d
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Thu Sep 1 12:35:07 2022 +0200

    fortran: Support clobbering of derived types [PR41453]
    
    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_10.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc                        | 18 ++++++-
 gcc/testsuite/gfortran.dg/intent_optimize_10.f90 | 66 ++++++++++++++++++++++++
 2 files changed, 83 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 52b96fa6cf6..4f3ae82d39c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6526,8 +6526,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			  && e->symtree->n.sym
 			  && !e->symtree->n.sym->attr.dimension
 			  && 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_10.f90 b/gcc/testsuite/gfortran.dg/intent_optimize_10.f90
new file mode 100644
index 00000000000..d8bc1bb3b7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_10.f90
@@ -0,0 +1,66 @@
+! { 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, neither derived type components, so there is a clobber for tc only;
+! no clobber for uc, ud, te, tf.
+! { dg-final { scan-tree-dump-times "CLOBBER" 1 "original" } }
+! { dg-final { scan-tree-dump "tc = {CLOBBER};" "original" } }
+
+! There is a clobber for tc, so we should manage to optimize away the associated initialization constant (but not other
+! initialization constants).
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target __OPTIMIZE__ } } }