This adds support for clobbering of partial variable references, when
they are passed as actual argument and the associated dummy has the
INTENT(OUT) attribute.
Support includes array elements, derived type component references,
and complex real or imaginary parts.

This is done by removing the check for lack of subreferences, which is
basically a revert of r9-4911-gbd810d637041dba49a5aca3d085504575374ac6f.
This removal allows more expressions than just array elements,
components and complex parts, but the other expressions are excluded by
other conditions: substrings are excluded by the check on expression
type (CHARACTER is excluded), KIND and LEN references are rejected by
the compiler as not valid in a variable definition context.

The check for scalarness is also updated as it was only valid when there
was no subreference.

        PR fortran/88364
        PR fortran/41453

gcc/fortran/ChangeLog:

        * trans-expr.cc (gfc_conv_procedure_call): Don’t check for lack
        of subreference.  Check the global expression rank instead of
        the root symbol dimension attribute.

gcc/testsuite/ChangeLog:

        * gfortran.dg/intent_optimize_7.f90: New test.
---
 gcc/fortran/trans-expr.cc                     |  5 +-
 .../gfortran.dg/intent_optimize_7.f90         | 65 +++++++++++++++++++
 2 files changed, 66 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_7.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ae685157e22..f1026d7f309 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6521,10 +6521,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                          && !dsym->attr.allocatable
                          && !dsym->attr.pointer
                          && e->expr_type == EXPR_VARIABLE
-                         && e->ref == NULL
-                         && e->symtree
-                         && e->symtree->n.sym
-                         && !e->symtree->n.sym->attr.dimension
+                         && e->rank == 0
                          && e->ts.type != BT_CHARACTER
                          && e->ts.type != BT_DERIVED
                          && e->ts.type != BT_CLASS
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_7.f90 
b/gcc/testsuite/gfortran.dg/intent_optimize_7.f90
new file mode 100644
index 00000000000..14dcfd9961b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_7.f90
@@ -0,0 +1,65 @@
+! { 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 one clobber to be emitted in
+! the caller before each call to FOO or BAR in the *.original dump, and the
+! initialization constants to be optimized away in the *.optimized dump,
+! in the case of scalar array elements, derived type components,
+! and complex real and imaginary part.
+
+module x
+implicit none
+contains
+  subroutine foo(a)
+    integer, intent(out) :: a
+    a = 42
+  end subroutine foo
+  subroutine bar(a)
+    real, intent(out) :: a
+    a = 24.0
+  end subroutine bar
+end module x
+
+program main
+  use x
+  implicit none
+  type :: t
+    integer :: c
+  end type t
+  type(t) :: dc
+  integer :: ac(3)
+  complex :: xc, xd
+
+  dc = t(123456789)
+  call foo(dc%c)
+  if (dc%c /= 42) stop 1
+
+  ac = 100
+  ac(2) = 987654321
+  call foo(ac(2))
+  if (any(ac /= [100, 42, 100])) stop 2
+
+  xc = (12345.0, 11.0)
+  call bar(xc%re)
+  if (xc /= (24.0, 11.0)) stop 3
+
+  xd = (17.0, 67890.0)
+  call bar(xd%im)
+  if (xd /= (17.0, 24.0)) stop 4
+
+end program main
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 4 "original" } }
+! { dg-final { scan-tree-dump "dc\\.c = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "ac\\\[1\\\] = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "REALPART_EXPR <xc> = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "IMAGPART_EXPR <xd> = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump     "123456789" "original" } }
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target 
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump     "987654321" "original" } }
+! { dg-final { scan-tree-dump-not "987654321" "optimized" { target 
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump     "1\\.2345e\\+4" "original"  } }
+! { dg-final { scan-tree-dump-not "1\\.2345e\\+4" "optimized" { target 
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump     "6\\.789e\\+4" "original"  } }
+! { dg-final { scan-tree-dump-not "6\\.789e\\+4" "optimized" { target 
__OPTIMIZE__ } } }
-- 
2.35.1

Reply via email to