https://gcc.gnu.org/g:94fa992b60e53dcf807fc7055ab606d828b931d8

commit r16-518-g94fa992b60e53dcf807fc7055ab606d828b931d8
Author: Harald Anlauf <anl...@gmx.de>
Date:   Tue May 6 20:59:48 2025 +0200

    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:
---
 gcc/fortran/dependency.cc                          |  6 ++-
 .../gfortran.dg/transfer_array_subref.f90          | 48 ++++++++++++++++++++++
 2 files changed, 53 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index 57c0c49391bd..aa8a57a80e0e 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 000000000000..b480dffd00bf
--- /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" } 
}

Reply via email to