]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: fix passing of inquiry ref of complex array to TRANSFER [PR102891]
authorHarald Anlauf <anlauf@gmx.de>
Tue, 6 May 2025 18:59:48 +0000 (20:59 +0200)
committerHarald Anlauf <anlauf@gmx.de>
Sat, 10 May 2025 20:46:56 +0000 (22:46 +0200)
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
gcc/testsuite/gfortran.dg/transfer_array_subref.f90 [new file with mode: 0644]

index 57c0c49391bd274e22f0b4bd7bb49f5761449e02..aa8a57a80e0ee4b55633dfd3410a85bf8a631261 100644 (file)
@@ -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 (file)
index 0000000..b480dff
--- /dev/null
@@ -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" } }