From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 6 May 2025 18:59:48 +0000 (+0200)
Subject: Fortran: fix passing of inquiry ref of complex array to TRANSFER [PR102891]
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=94fa992b60e53dcf807fc7055ab606d828b931d8;p=thirdparty%2Fgcc.git

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.
---

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" } }