Dear all,
here's another rather obvious case where a temporary is needed for
an inquiry reference of a complex array which is a component of a
derived type. In contrast to PR119986, the argument is handled
within the code for the intrinsic TRANSFER, so that the other
patch did not catch the present one.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
I'd also like to backport this one to 15-branch if this is ok.
Thanks,
Harald
From 981aa53bc258d3c3b75ecdcd33d993346db1fd12 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Tue, 6 May 2025 20:59:48 +0200
Subject: [PATCH] Fortran: fix passing of inquiry ref of complex array to
TRANSFER [PR102891]
PR fortran/102891
gcc/fortran/ChangeLog:
* dependency.cc (gfc_ref_needs_temporary_p): Within an array
reference, inquiry references of complex variables generally
need a temporary.
gcc/testsuite/ChangeLog:
* gfortran.dg/transfer_array_subref.f90: New test.
---
gcc/fortran/dependency.cc | 6 ++-
.../gfortran.dg/transfer_array_subref.f90 | 48 +++++++++++++++++++
2 files changed, 53 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/transfer_array_subref.f90
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index 57c0c49391b..aa8a57a80e0 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -944,8 +944,12 @@ gfc_ref_needs_temporary_p (gfc_ref *ref)
types), not in characters. */
return subarray_p;
- case REF_COMPONENT:
case REF_INQUIRY:
+ /* Within an array reference, inquiry references of complex
+ variables generally need a temporary. */
+ return subarray_p;
+
+ case REF_COMPONENT:
break;
}
diff --git a/gcc/testsuite/gfortran.dg/transfer_array_subref.f90 b/gcc/testsuite/gfortran.dg/transfer_array_subref.f90
new file mode 100644
index 00000000000..b480dffd00b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_subref.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! { dg-additional-options "-O2 -fdump-tree-optimized" }
+!
+! PR fortran/102891 - passing of inquiry ref of complex array to TRANSFER
+
+program main
+ implicit none
+ integer, parameter :: dp = 8
+
+ type complex_wrap1
+ complex(dp) :: z(2)
+ end type complex_wrap1
+
+ type complex_wrap2
+ complex(dp), dimension(:), allocatable :: z
+ end type complex_wrap2
+
+ type(complex_wrap1) :: x = complex_wrap1([ (1, 2), (3, 4) ])
+ type(complex_wrap2) :: w
+
+ w%z = x%z
+
+ ! The following statements should get optimized away...
+ if (size (transfer ( x%z%re ,[1.0_dp])) /= 2) error stop 1
+ if (size (transfer ((x%z%re),[1.0_dp])) /= 2) error stop 2
+ if (size (transfer ([x%z%re],[1.0_dp])) /= 2) error stop 3
+ if (size (transfer ( x%z%im ,[1.0_dp])) /= 2) error stop 4
+ if (size (transfer ((x%z%im),[1.0_dp])) /= 2) error stop 5
+ if (size (transfer ([x%z%im],[1.0_dp])) /= 2) error stop 6
+
+ ! ... while the following may not:
+ if (any (transfer ( x%z%re ,[1.0_dp]) /= x%z%re)) stop 7
+ if (any (transfer ( x%z%im ,[1.0_dp]) /= x%z%im)) stop 8
+
+ if (size (transfer ( w%z%re ,[1.0_dp])) /= 2) stop 11
+ if (size (transfer ((w%z%re),[1.0_dp])) /= 2) stop 12
+ if (size (transfer ([w%z%re],[1.0_dp])) /= 2) stop 13
+ if (size (transfer ( w%z%im ,[1.0_dp])) /= 2) stop 14
+ if (size (transfer ((w%z%im),[1.0_dp])) /= 2) stop 15
+ if (size (transfer ([w%z%im],[1.0_dp])) /= 2) stop 16
+
+ if (any (transfer ( w%z%re ,[1.0_dp]) /= x%z%re)) stop 17
+ if (any (transfer ( w%z%im ,[1.0_dp]) /= x%z%im)) stop 18
+
+ deallocate (w%z)
+end program main
+
+! { dg-final { scan-tree-dump-not "_gfortran_error_stop_numeric" "optimized" } }
--
2.43.0
